Personal tools
Document Actions

odra.3 prolsource

by Paul McJones last modified 2019-05-20 16:52

INTERPRETER PROLOGU (GROUPE D'INTELLIGENCE ARTIFICIELLE,U.E.R MARSEILLE - LUMINY / INSTYTUT INFORMATYKI,UNIWERSYTET WARSZAWSKI ) WERSJA UZYTKOWA 1.C (KWIECIEN 1983R.)

C***********************************************************************
C*                                                                     *
C*     ** I N T E R P R E T E R    P R O L O G U **                    *
C*                                                                     *
C*   (GROUPE D'INTELLIGENCE ARTIFICIELLE,U.E.R MARSEILLE - LUMINY /
C*     INSTYTUT INFORMATYKI,UNIWERSYTET WARSZAWSKI )                   *
C*                                                                     *
C*    WERSJA UZYTKOWA 1.C  (KWIECIEN    1983R.)                         *
C*                                                                     *
C***********************************************************************
C
C
C-----------------------------------------------------------------------
C WZOR KART STERUJACYCH :
CEXEC DUMP ON
CEXEC LIBRARY(SUBGROUPFSCE)
CEXEC PROGRAM(PROL)
CEXEC COMPRESS INTEGER AND LOGICAL
CEXEC INPUT 1=ED1/(UNKNOWNASYET)
CEXEC INPUT 2=ED2/FORMATTED(UNKNOWNASYET)
CEXEC OUTPUT 3=ED3/(UNKNOWNASYET)
CEXEC INPUT 5=CR0
CEXEC OUTPUT 6=LP0
CEXEC CREATE 8=MT8/FORMATTED(DRUKARKA)
CEXEC OUTPUT 9=ED9/FORMATTED(UNKNOWNASYET)
CEXEC TRACE 0
CEXEC END
C
C-----------------------------------------------------------------------
C
C  PLIKI :
C PLIK 1 : CZYTANIE STANU INICJALNEGO
C PLIK 2 : CZYTANIE TEKSTU (DODATKOWY,POR.PROCEDURA TTY)
C PLIK 3 : PISANIE STANU PAMIECI
C PLIK 5 : CZYTANIE TEKSTU (STANDARD)
C PLIK 6 : WYDRUK (STANDARD)
C PLIK 8 : WYDRUK ZAMIAST 6  (--> PRZELACZNIKI)
C PLIK 9 : WYDRUK  (DODATKOWY,POR.PROCEDURA DOUBLE)
C
C ** PLIKI 1 I 3 MOGA BYC TYM SAMYM PLIKIEM,POR. KARTA STERUJACA PROLOGU
C ** MINIMALNE WYMAGANIA : 1 , 5 ORAZ 6 LUB 8 **
C
C-----------------------------------------------------------------------
C
C PRZELACZNIKI :
C SWITCH 0 : WYLACZANIE MOZLIWOSCI SLEDZENIA (W DOWOLNEJ CHWILI)
C SWITCH 5 : ZWALNIANIE CZYTNIKA PO TTY (W DOWOLNEJ CHWILI)
C SWITCH 6 : PISANIE NA 8 ZAMIAST NA 6 (PRZED WCZYTANIEM STANU)
C
C-----------------------------------------------------------------------

C  POPRAWKI:
C  BOOLISTE,NEET,ATOME,ARITH
C  NOWE PREDYKATY OBLICZALNE : RANDOM,IMPASSE,EGVAR
C  LICZNIK MAKSYMALNEGO ZUZYCIA PAMIECI
C  KWIECIEN 1983R.
C
      MASTER PROL
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER DTAB,DPILE,ITER,IVAR,IBAC,IREC
      INTEGER CLES(800),CALCUL(256)
      INTEGER POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      INTEGER MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,AXNIL,
     * AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      INTEGER AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,MESS,
     * TRACRH
     *,DB,DBWAS
      INTEGER ENTRE(80),ENTRE2(80),SORTIE(120),SORTI2(120)
      INTEGER LECMAX,IMPMAX,IENTRE,IENTR2,ISORTI,ISORT2,W
      INTEGER TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      INTEGER KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,ARG,
     * DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     *  COMPTE,LIMITE
      INTEGER WERSJA(7)
      INTEGER STSIZE,TOP,S(99)
      INTEGER LIMIT,LAST,LBUF(113)
      INTEGER PILMIN,TABMIN
      COMMON  TAB  /MSTACK/ PILE
      COMMON/GENGEN/ LOS,LOSP
      COMMON /RUNSYS/ DTAB,DPILE,ITER,IVAR,IBAC,IREC
      COMMON /AUXTAB/ CLES,CALCUL
      COMMON /DATSTR/ POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      COMMON /CONST/ MARGE,NBRE,LETTRE,CHIFFR,CARACT,
     * CNIL,CPOINT,AXNIL,AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      COMMON /SYSWIT/ AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,
     * MESS,TRACRH
     *,DB,DBWAS
     * ,IMPTRA
      COMMON /IOBUF/ ENTRE,ENTRE2,SORTIE,SORTI2
      COMMON /IOCV/ LECMAX,IMPMAX,IENTRE,IENTR2,ISORTI,ISORT2,W
      COMMON /COMMUN/ TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      COMMON /AUXVAR/ KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,
     * ARG,DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     * COMPTE,LIMITE
      COMMON /STATYS/ ITERS,IVARS,IBACS,IRECS
      COMMON /WERSJA/ WERSJA
      COMMON /BLANK/ IBLANK,LEC120
      COMMON /TSTACK/ STSIZE,TOP,S
      COMMON /IOTR/ LIMIT,LAST,LBUF
      COMMON /SCHIND/ KBLANK,ILPAR,IRPAR,ISTAR,IQMARK,ICOMMA,ISLASH
      COMMON/LEVEL/LEVEL
      COMMON /CASCAD/ ICASC
      COMMON /TRNUM/ NTR,LLAST
      COMMON /MINMIN/ PILMIN,TABMIN
      LOS=49
      LOSP=0
C  WCZYTANIE STANU I PRZYGOTOWANIE STATYSTYKI
      CALL ENTSORT(1)
       ITERS=ITER
      IVARS=IVAR
      IBACS=IBAC
      IRECS=IREC
      PILMIN=DPILE
      TABMIN=DTAB
C  GLOWNA PETLA OD 2. INPL = : 0 (JAZDA),1 (SAUVE), 2 (STOP)
    2 IF (INPL.EQ.0) GO TO 1
      IF(INPL.EQ.2) CALL KONIEC
      CALL ENTSORT(3)
      IF(INPL.EQ.1) CALL KONIEC
      INPL=0
C  IBAC JEST ADRESEM DRUGIEGO ELEMENTU CZWORKI (ADRES KROPKI PRZED
C  LITERALEM)
C  TERM : ADRES PREDYKATU LITERALU
C  INST : ADRES STREFY ZMIENNYCH KLAUZULI ZAWIERAJACEJ LITERAL
C  ("PODSTAWIENIE POPRZEDNIKA")
    1 TERM= PILE(IBAC) +2
      INST=PILE(PILE(IBAC-1)+2)
      IF(TAB(TERM).GE.0) GOTO 78
C TU JESLI -*X  LUB  +*X
      CALL DESC
      IF(TAB(TERM).LT.0) GO TO 34
C I : ADRES GLOWY LIST KLAUZUL DLA LITERALU
   78 I= -TAB(TAB(TERM)+PRED)
C  RETOUR : PRZECHOWANIE IBAC DLA POWROTU LUB JAKO ADRES POPRZEDNIKA
C  LIMITE : POCATEK STREF ZMIENNYCH NIE NALEZACYCH DO WOLANEJ KLAUZULI
   79 RETOUR=IBAC
      LIMITE = IVAR+2
C CZY TRACERES ?
      IF(TRACRH.EQ.0) GO TO 799
      IF(TERM.LE.LEVEL) GO TO 799
      CALL SSWTCH(0,KSW)
      IF(KSW.EQ.1) GO TO 799
      KT=TERM
      KI=INST
      NTR=1
      LLAST=1
      CALL TRTERM
      TERM=KT
      INST=KI
  799 CONTINUE
      IF(-I) 4,3056,11
C***********************************************************************
C* PREDICATS EVALUABLES................................................*
C***********************************************************************
C  EVAL = 1 DLA LITERALU Z MINUSEM 0 - Z PLUSEM
    4 IF(TAB(PILE(IBAC)+1).EQ.PLUS) GO TO 8
      EVAL=1
      GO TO 9
    8 EVAL=0
C 3-CI I 4-TY ELEMENT 4-KI : ADRES ADRESU KLAUZULI (PUNKT NAWROTU)
C  I ADRES PARY POPRZEDZAJACEJ STREFE ZMIENNYCH LOKALNYCH
    9 PILE(IBAC+1) = 0
      PILE((IBAC+2))=(IVAR+2)
C JESLI JEST MIEJSCE W STOSIE,IBAC NA 1-SZY ELEMENT NASTEPNEJ 4-KI I
C  JAZDA
      IF(IREC-IBAC.LE.MARGE) CALL MESSAGE(2)
      IBAC=IBAC+3
      IF(IREC-IBAC.LT.PILMIN) PILMIN=IREC-IBAC
      GO TO(110,120,130,140,150,160,170,180,190,200,
     2      210,220,230,240,250,260,270,280,290,300,
     *      310,320,330,340,350,360,370,380,385,
     *      390,400,410,420,430,440,450,460,470,480,490,
     *      500,510,520,530,540,550,560,570),I
   10 CONTINUE
C
C * * * * *   S O R E V  * * * * *
C T: 0(PRAWDA),1(FALSZ),2(BLEDNE WYWOLANIE)
C EVAL: 0(+),1(-)
      IF(T.NE.EVAL) GO TO 1030
      T = 1
      GO TO 36
C RESTER: ADRES ZNAKU LITERALU WOLAJACEGO OBLICZALNY
C CLAUSR: ADRES KROPKI PRZED NASTEPNYM LITERALEM LUB NILA
 1030 RESTER=PILE(RETOUR) +1
      CALL SAUT
      CLAUSR=RESTER-1
      IF(T.NE.2) GO TO 1050
C SYMULACJA WOLANIA ERREUR
      CLAUSA=ERREUR -1
      IF(IVAR-ITER.LE.MARGE) CALL MESSAGE(1)
      IVAR=IVAR-2
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
C LOCAL: ADRES STREFY ARGUMENTU ERREUR
C (TERM,INST: ADRES KROPKI PRZED LITERALEM I STREFY ZMIENNYCH
C JEGO KLAUZULI)
      LOCAL=IVAR+2
      TAB(LOCAL) = PILE(RETOUR) +2
      TAB(LOCAL-1) = PILE(PILE(RETOUR-1)+2)
      T = 0
      GO TO 62
C AXNIL: ADRES TERMU NIL
 1050 CLAUSA = AXNIL-1
      T=0
      GO TO 62
C ** KONIEC SOREV **
C
C***********************************************************************
C* RECHERCHE DE L'AXIOME    INITIALISATION DES POINTEURS...............*
C***********************************************************************
C  USTAWIENIE 3-GO ELEMENTU 4-KI NA POCZATEK WLASCIWEJ LISTY KLAUZUL
C LUB NAWROT
   11 IF(TAB(PILE(IBAC)+1).EQ.PLUS) GO TO 30
      KF=TAB(-I+ACPL)
      IF(KF.EQ.0) GO TO 3056
      GO TO 39
   30  KF=TAB(-I+ACMO)
      IF(KF.EQ.0) GO TO 3056
      GO TO 39
C PUSTA LISTA KLAUZUL
   34 IBAC=IBAC-1
C  NAWROT
   36 CONTINUE
C
C * * * * *  B A C K T  * * * * *
C NA WEJSCIU IBAC JEST ADRESEM 1-SZEGO ELEMENTU NIEDOKONCZONEJ 4-KI
 3010 IBAC=IBAC-1
      ICHERI=PILE(IBAC)
      IF(ICHERI.GE.0) GO TO 3030
C MINUS W STOSIE - UWOLNIENIE ZMIENNEJ
      TAB(-ICHERI) = 0
      TAB(-ICHERI-1) =0
      GO TO 3010
C ZNISZCZENIE STREFY ZMIENNYCH (POPRZEDNIEGO) DOBREGO WOLANIA
 3030 J=ICHERI -2
      DO 3032 I=IVAR,J
 3032 TAB(I)=0
      IVAR=J
C IBAC: 2-GI EL.REKONSTRUOWANEJ 4-KI,ICHER:ADRES EL.LISTY KLAUZUL
      IBAC=IBAC-2
 3050 ICHERI = PILE(IBAC+1)
      IF(ICHERI.EQ.0) GO TO 3056
      I=TAB(ICHERI+SUIV)
      IF(I.NE.0) GO TO 3070
C KONIEC LISTY KLAUZUL. COFAMY DALEJ JESLI MOZNA
 3056 IF(IBAC.EQ.BOULOT) GO TO 3058
C ZEROWY ADRES ELEMENTU LISTY KLAUZUL
C DRUKUJ LITERAL IMPASUJACY JESLI TRACEIMP I NIE SWITCH 0
      IF(IMPTRA.EQ.0) GO TO 3057
      CALL SSWTCH(0,KSW)
      IF(KSW.EQ.1) GO TO 3057
      KT=TERM
      KI=INST
      TERM=PILE(IBAC)+2
      INST=PILE(PILE(IBAC-1)+2)
      CALL DESC
      IF(TERM.LE.LEVEL) GO TO 3055
      NTR=2
      LLAST=1
      CALL TRTERM
 3055 CONTINUE
      TERM=KT
      INST=KI
 3057 CONTINUE
      IBAC=IBAC-1
      GO TO 3010
C PUSTA REZOLWENTA : KONIEC DOWODZENIA
 3058 U=1
      IF(INPL.NE.0) CALL ENTSORT(3)
C JEDZIEMY DO NASTEPNEJ KLAUZULI
 3070 PILE(IBAC+1) = I
      RETOUR=IBAC
      LIMITE = PILE(IBAC+2)
 3099 CONTINUE
C ***KONIEC BACKT***
C
      IF(U.NE.1) GO TO 42
      U=0
      CALL KONIEC
C
C
C
C  JAZDA.JESLI TO NOWA J-KA,TO USTAW WSKAZNIK STREFY ZMIENNYCH
   39 PILE(IBAC+1) =KF
   40 PILE((IBAC+2))=(IVAR+2)
C STREFA ZMIENNYCH MA ROZMIAR 2*ILOSC ZMIENNYCH W KLAUZULI
   42 KCLO = TAB(PILE(IBAC+1)+CLO)
      IVAR = IVAR-2*TAB(KCLO-1)
      IF(IVAR -ITER.LE.MARGE) CALL MESSAGE(1)
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
C CLAUSA : PREDYKAT NAGLOWKA, INSTA : STREFA ZMIENNYCH TEJ KLAUZULI
      CLAUSA = KCLO+2
      INSTA = LIMITE
C CLAUSR : PREDYKAT LITERALU, INSTR : STREFA ZMIENNYCH JEGO KLAUZULI
C OPISANA PRZEZ 4-KE POPRZEDNIKA
      CLAUSR=PILE( IBAC)+2
      INSTR=PILE( PILE( IBAC-1)+2)
C  IBAC NA 1-SZY ELEMENT NASTEPNEJ 4-KI
      IF (IREC-IBAC.LE.MARGE) CALL MESSAGE(2)
      IBAC=IBAC+3
      IF(IREC-IBAC.LT.PILMIN) PILMIN=IREC-IBAC
C***********************************************************************
C* UNIFICATION.........................................................*
C***********************************************************************
      CALL UNIFIE
   60 IF(T.EQ.1) GO TO 36
C***********************************************************************
C* REPOSITIONNEMENT DE LA RESOLVANTE...................................*
C***********************************************************************
C  NA KROPKE NASTEPNEGO LITERALU PO NAGLOWKU I PO LITERALE WOLAJACYM
   62 CLAUSA=CLAUSA+1
      CLAUSR=CLAUSR+1
C I : ADRES POPRZEDNIKA KLAUZULI WOLAJACEJ
      I=PILE( RETOUR-1)
       IF(TAB(CLAUSA).EQ.CNIL) GO TO 69
C  KLAUZULA WOLAJACA STAJE SIE POPRZEDNIKIEM,WOLANA : POCZATKIEM
C   REZOLWENTY
      PILE(IBAC)=RETOUR
      IBAC=IBAC+1
      IF(IREC-IBAC.LT.PILMIN) PILMIN=IREC-IBAC
      PILE(IBAC)=CLAUSA
      GO TO 2
C
   69 IF(TAB(CLAUSR).NE.CNIL) GO TO 90
C  POCZATEK REZOLWENTY GDZIES U POPRZEDNIKOW
   80 IF(I.EQ.0) GO TO 36
      RESTER=PILE( I)+1
      CALL SAUT
      IF(TAB(RESTER).NE.CNIL) GO TO 84
      I=PILE(I-1)
      GO TO 80
C KONTYNUACJA NIEDOKONCZONEGO POPRZEDNIKA
   84 PILE(IBAC)=PILE( I-1)
      IBAC=IBAC+1
      IF(IREC-IBAC.LT.PILMIN) PILMIN=IREC-IBAC
      PILE(IBAC)=RESTER
      GO TO 92
C WYWOLANA KLAUZULA BYLA UNARNA,KONTYNUACJA WOLAJACEJ
   90 PILE (IBAC)=I
      IBAC=IBAC+1
      IF(IREC-IBAC.LT.PILMIN) PILMIN=IREC-IBAC
      PILE(IBAC)=CLAUSR
C TERAZ PROBA SKASOWANIA NIEPOTRZEBNYCH CZWOREK
   92 KFRAME = IBAC-1
      KFANC = PILE(KFRAME) +2
      J = KFRAME -1
C OMINIECIE INFO O PODSTAWIENIACH
   93 IF(PILE(J).GE.0) GO TO 94
      J=J-1
      GO TO 93
C OMINIECIE CZWORKI Z ZEROWYM ADRESEM ELEMENTU LISTY KLAUZUL
   94 IF(J.EQ.KFANC) GO TO 96
      KFCLAD=PILE(J-1)
      IF(KFCLAD.NE.0) GO TO 95
      J=J-4
       GO TO 93
C OMINIECIE CZWORKI Z ZEROWYM NASTEPNIKIEM KLAUZULI
   95 IF(ICASC.NE.0) GO TO 96
      IF(TAB(KFCLAD+SUIV).NE.0) GO TO 96
      J= J-4
      GO TO 93
C KOMPAKTYFIKACJA. ZACHOWANIE INFORMACJI O PODSTAWIENIACH I
C BIEZACEJ RAMY
   96  J= J+1
      KF=J
   97 IF(PILE(KF).GE.0) GO TO 98
      PILE(J) = PILE(KF)
      J=J+1
      KF=KF+1
      GO TO 97
   98 IF(KF.EQ.KFRAME) GO TO 99
      KF= KF+4
      GO TO 97
   99 IF(KF.EQ.J) GO TO 2
      PILE(J) = PILE(KF)
      PILE(J+1) = PILE(KF+1)
      IBAC=J+1
      GO TO 2
C***********************************************************************
C* APPEL DES PREDICATS EVALUABLES......................................*
C***********************************************************************
C LU - 1
  110 CALL ENTSORT(6)
      GO TO 10
C UNIV - 2
  120 CALL UNIV
      GO TO 10
C AJOUT - 1
  130 CALL AJOUT
      GO TO 10
C IMPRRES - 0
  140 CALL IMPRES
      GO TO 10
C / - 0
  150 CALL SLASH1
      GO TO 10
C / - 1
  160 CALL SLASH2
      GO TO 10
C ECRIT - 1
  170 CALL ENTSORT(7)
      GO TO 10
C SUPP - 1
  180 CALL SUPP
      GO TO 10
C PLUS - 3
  190 CALL ARITH(1)
      GO TO 10
C MOINS - 3
  200 CALL ARITH(2)
      GO TO 10
C LETTRE - 1
  210 TERM=TERM+1
      CALL DESC
      IABT=TAB(TERM)-2
      IF(IABT .GT. CARACT .AND. IABT .LE. LETTRE)GO TO 10
      T=1
      GO TO 10
C CHIFFRE - 1
  220 TERM=TERM+1
      CALL DESC
      IABT=TAB(TERM)-2
      IF(IABT .GT. LETTRE .AND. IABT .LE. CHIFFR)GO TO 10
      T=1
      GO TO 10
C SAUVESTOP - 0
  230 IF(EVAL .EQ. 0)GO TO 10
      INPL=1
      GO TO 10
C LIGNE - 0
  240 CALL ENTSORT (8)
      GO TO 10
C INF - 2
  250 CALL INF
      GO TO 10
C LUB - 1
  260 LUB=1
      CALL ENTSORT(6)
      LUB=0
      GO TO 10
C ANCETRE - 1
  270 CALL ANCETR
      GO TO 10
C DIV - 3
  280 CALL ARITH(3)
      GO TO 10
C RESTE - 3
  290 CALL ARITH(4)
      GO TO 10
C MULT - 3
  300 CALL ARITH(5)
      GO TO 10
C AJOUTB - 1
  310 AJB=1
      CALL AJOUT
      AJB=0
      GO TO 10
C ATOME - 2
  320 UNAT=1
      CALL UNIV
      UNAT=0
      GO TO 10
C IMPRANC - 1
  330 CALL IMPRAN
      GO TO 10
C VAR - 1
340   TERM=TERM+1
      CALL DESC
      IABT=TAB(TERM)
      IF(IABT .LT. 0 .AND. IABT .GT. NBRE)GO TO 10
      T=1
      GO TO 10
C IMPRHET - 0
  350 CALL IMPHET
      GO TO 10
C BOOLISTE - 0
  360 IF(EVAL .EQ. 0)GO TO 10
      BOOL=1-BOOL
      IF(BOOL.NE.0) GO TO 365
      OLDCLO=CLOCON
      CLOCON=0
      GO TO 10
  365 CLOCON=OLDCLO
      GO TO 10
C IMPRIME - 0
370   IF (EVAL.EQ.0) GO TO 10
      IF(BOOL.EQ.1)GO TO 10
      IF (TT.EQ.2) GO TO 372
      CALL ENTSORT(4)
      GO TO 10
  372 CALL ENTSORT(5)
      GO TO 10
C TTY - 0
380   IF (EVAL.EQ.0) GO TO 10
      CALL TTY
      GO TO 10
C ENTREE - 0
  385 IF(EVAL.EQ.0) GO TO 10
      IF (TT.EQ.2) GO TO 386
      CALL ENTSORT(9)
      GO TO 10
  386 CALL ENTSORT(10)
      GO TO 10
C AJOUTC - 1
  390 AJC=1
      CALL AJOUT
      AJC=0
      GO TO 10
C HEURETAT - 0
  400 CONTINUE
      CLOCON = 1-CLOCON
      GO TO 10
C NETT - 0
  410 IF(EVAL .EQ. 0)GO TO 10
      INPL=3
      NETTO=1
      GOTO 10
C SAUVE - 0
  420 CONTINUE
      IF(EVAL.EQ.0) GO TO 10
      INPL=3
      GOTO 10
C ENTFIN - 0
  430 IF(TT.EQ.2) GO TO 435
      IF(IENTRE.NE.LECMAX) T=1
      GO TO 10
  435 IF(IENTR2.NE.LECMAX) T=1
      GO TO 10
C SORFIN - 0
  440 IF(DB.EQ.1) GO TO 445
      IF(ISORTI.NE.IMPMAX) T=1
      GO TO 10
  445 IF(ISORT2.NE.LECMAX) T=1
      GO TO 10
C ENTREC - 0
  450 IF(TT.EQ.2) GO TO 455
      IF(IENTRE.EQ.0) GO TO 459
      IENTRE=IENTRE-1
      GO TO 10
  455 IF(IENTR2.EQ.0) GO TO 459
      IENTR2=IENTR2-1
      GO TO 10
  459 T=1
      GO TO 10
C SORREC - 0
  460  IF(DB.EQ.1) GO TO 465
      IF(ISORTI.EQ.0) GO TO 469
      ISORTI=ISORTI-1
      GO TO 10
  465 IF(ISORT2.EQ.0) GO TO 469
      ISORT2=ISORT2-1
      GO TO 10
  469  T=1
      GO TO 10
C NIVEAU - 0
  470 LEVEL = ITER
      GO TO 10
C TRACERES - 0
  480 TRACRH = 1-TRACRH
      GO TO 10
C TRACEIMP - 0
  490 IMPTRA=1-IMPTRA
      GO TO 10
C RESERVE - 2
  500 KT=TERM
      KI=INST
      TERM=KT+1
      CALL DESC
      IF(TAB(TERM).GE.0.OR.TAB(TERM).LE.NBRE) GO TO 509
      LOCAL = INST+2*TAB(TERM)
      TAB(LOCAL) = LOCAL-1
      TAB(LOCAL-1) = NBRE -(IVAR-ITER)
      IF(LOCAL.GE.LIMITE) CALL SUBST
      TERM=KT+2
      INST=KI
      CALL DESC
      IF(TAB(TERM).GE.0.OR.TAB(TERM).LE.NBRE) GO TO 509
      LOCAL=INST+2*TAB(TERM)
      TAB(LOCAL) = LOCAL-1
      TAB(LOCAL-1)= NBRE-(IREC-IBAC)
      IF(LOCAL.GE.LIMITE) CALL SUBST
      GO TO 10
  509 T=2
      GO TO 10
C DOUBLE - 0
  510 DB=1-DB
      IF(DBWAS.EQ.0) CALL ENTSORT(11)
      GO TO 10
C CASCADE - 0
  520 ICASC = 1-ICASC
      GO TO 10
C  IMPASSE - 0
530    IF(EVAL .EQ. 0 ) GO TO 10
       T = 1
       GO TO 10
C  RANDOM - 1
540    TERM = TERM +1
       CALL DESC
       ILE = TAB(TERM)
       IF( ILE .GT. NBRE) GO TO 541
       ILE = NBRE - ILE
       GO TO 543
541    IF(ILE .GT. LETTRE+2 .AND. ILE .LE. CHIFFR+2) GO TO 542
       T=2
       GO TO 10
542    ILE = (ILE-LETTRE-8)/6
543    CONTINUE
      CALL RANDOM
        IF(LOS .GE. ILE) T=1
       GO TO 10
C  PAUSE - 0
  550  PAUSE USER
       GO TO 10
C  _TEST - 1
  560  CONTINUE
       GO TO 10

C  EGVAR
  570  KT=TERM
        KI=INST
       TERM=KT+1
       CALL DESC
       IABT=TAB(TERM)
       IF(IABT.GE.0.OR.IABT.LE.NBRE) GO TO 575
       LOCAL=INST+2*IABT
       TERM=KT+2
       INST=KI
        CALL DESC
       IABT = TAB(TERM)
       IF(IABT.GE.0.OR.IABT.LE.NBRE) GO TO 575
       IF(LOCAL.EQ.INST+2*IABT) GO TO 10
  575  T=1
       GO TO 10
      END
      BLOCK DATA
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER DTAB,DPILE,ITER,IVAR,IBAC,IREC
      INTEGER CLES(800),CALCUL(256)
      INTEGER POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      INTEGER MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,AXNIL,
     * AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      INTEGER AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,MESS,
     * TRACRH
     *,DB,DBWAS
      INTEGER ENTRE(80),ENTRE2(80),SORTIE(120),SORTI2(120)
      INTEGER LECMAX,IMPMAX,IENTRE,IENTR2,ISORTI,ISORT2,W
      INTEGER TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      INTEGER KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,ARG,
     * DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     *  COMPTE,LIMITE
      INTEGER WERSJA(7)
      INTEGER STSIZE,TOP,S(99)
      INTEGER LIMIT,LAST,LBUF(113)
      COMMON  TAB  /MSTACK/ PILE
      COMMON /RUNSYS/ DTAB,DPILE,ITER,IVAR,IBAC,IREC
      COMMON /AUXTAB/ CLES,CALCUL
      COMMON /DATSTR/ POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      COMMON /CONST/ MARGE,NBRE,LETTRE,CHIFFR,CARACT,
     * CNIL,CPOINT,AXNIL,AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      COMMON /SYSWIT/ AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,
     * MESS,TRACRH
     *,DB,DBWAS
     *,IMPTRA
      COMMON /IOBUF/ ENTRE,ENTRE2,SORTIE,SORTI2
      COMMON /IOCV/ LECMAX,IMPMAX,IENTRE,IENTR2,ISORTI,ISORT2,W
      COMMON /COMMUN/ TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      COMMON /AUXVAR/ KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,
     * ARG,DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     * COMPTE,LIMITE
      COMMON /STATYS/ ITERS,IVARS,IBACS,IRECS
      COMMON /WERSJA/ WERSJA
      COMMON /BLANK/ IBLANK,LEC120
      COMMON /TSTACK/ STSIZE,TOP,S
      COMMON /IOTR/ LIMIT,LAST,LBUF
      COMMON /SCHIND/ KBLANK,ILPAR,IRPAR,ISTAR,IQMARK,ICOMMA,ISLASH
      COMMON /CASCAD/ ICASC
      COMMON /LEVEL/ LEVEL
      DATA LEVEL /0/
      DATA DTAB,DPILE,IREC /&TAB,2*&PILE/
      DATA POIDS,PRED,NOM,AXTER,NEXT /0,1,2,3,4/,
     * ACPL,ACMO /0,1/, CLO,SUIV /0,1/, CODE /2/
      DATA MARGE,NBRE /10,-1000/,
     * LETTRE,CHIFFR,CARACT /314,374,158/,
     * CNIL,CPOINT,AXNIL,AXPOIN /386,391,385,396/,
     * PLUS,MOINS,BOULOT,ERREUR /399,406,2,454/
     * ,NIL /0/
      DATA AJB,AJC,UNAT,LUB,NETTO /0,0,0,0,0/,
     * TT,BOOL,CR /5,1,1/,
     * CLOCON,OLDCLO /0,0/,
     * MESS /0/, TRACRH /0/
     * ,DB,DBWAS /0,0/
     *,IMPTRA /0/
      DATA LECMAX,IMPMAX /80,120/
      DATA W /6/
      DATA U,T /0,0/
      DATA UNLETT,ENTIER,INPL /0,0,0/
      DATA IBLANK,LEC120 /1H ,40/
      DATA STSIZE,TOP /99,0/
      DATA LIMIT,LAST /110,0/
      DATA KBLANK,ILPAR,IRPAR,ISTAR,IQMARK,ICOMMA,ISLASH
     *     /4, 28, 70, 64, 124, 100, 94 /
      DATA ICASC /0/
      DATA WERSJA /4HINTE,4HRPRE,4HTER ,4HIIUW,
     * 4H.1.C,4H (04, 4H/83) /
      END
      SUBROUTINE RANDOM
      COMMON /GENGEN/ LOS,LOSP
      LOS=LOSP*100+LOS
      LOS=5*LOS+7
      LOS=MOD(LOS,1024)
      LOSP=LOS/100
      LOS=MOD(LOS,100)
      RETURN
      END
      SUBROUTINE KONIEC
      INTEGER DTAB,DPILE,ITER,IVAR,IBAC,IREC
      INTEGER AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,MESS,
     * TRACRH
      INTEGER LECMAX,IMPMAX,IENTRE,IENTR2,ISORTI,ISORT2,W
      INTEGER PILMIN,TABMIN
      INTEGER PILMAX,TABMAX
      COMMON /RUNSYS/ DTAB,DPILE,ITER,IVAR,IBAC,IREC
      COMMON /SYSWIT/ AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,
     * MESS,TRACRH
      COMMON /IOCV/ LECMAX,IMPMAX,IENTRE,IENTR2,ISORTI,ISORT2,W

      COMMON /MINMIN/PILMIN,TABMIN
C  *** KONIEC.  TABLICZKA ****
 1000 CALL ENTSORT(2)
C****EDITOR CORRECTION*******
      WRITE(W,600)
      CALL IMPHET
  600 FORMAT(///,15H STAN KONCOWY : )
      CALL DATE(FKDATE)
      CALL TIME(CZAS)
      PILMAX=DPILE-PILMIN
      TABMAX=DTAB-TABMIN
      WRITE(W,9998) PILMAX,TABMAX
 9998 FORMAT(1X,25HMAKSYMALNE ZUZYCIE STOSU ,I6,12H,  SLOWNIKA ,I6)
      WRITE(W,9997) FKDATE,CZAS
      IF(W.EQ.8) ENDFILE 8
 9997 FORMAT(17H0PROLOG: *KONIEC*,50X,4HDATA,2X,A8,10X,4HCZAS,2X,A8
     *  ,16X)
      IF(MESS.EQ.1) STOP MESS
      STOP OK
      END
      SUBROUTINE MESSAGE(J)
      INTEGER AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,MESS,
     * TRACRH
      INTEGER LECMAX,IMPMAX,IENTRE,IENTR2,ISORTI,ISORT2,W
      COMMON /SYSWIT/ AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,
     * MESS,TRACRH
      COMMON /IOCV/ LECMAX,IMPMAX,IENTRE,IENTR2,ISORTI,ISORT2,W
      MESS = 1
      GO TO (1,2,3,4,5),J
    1 WRITE(W,15)
      CALL KONIEC
   15 FORMAT(48H0**PRZEPELNIENIE TABLICY SLOWNIKA I PODSTAWIEN**  ,
     * 73X,/,121X)
    2 WRITE(W,16)
      CALL KONIEC
   16 FORMAT(24H0**PRZEPELNIENIE STOSU**,97X,/,121X)
    3 WRITE(W,17)
      CALL KONIEC
   17 FORMAT(20H0**STOS JEST PUSTY**,101X,/,121X)
    4 WRITE(W,18)
      CALL KONIEC
   18 FORMAT(47H0**STAN INICJALNY NIE ZMIESCI SIE W TABLICACH**  ,
     * 74X,/,121X)
    5 WRITE(W,19)
      CALL KONIEC
   19 FORMAT(28H**KONIEC PLIKU WEJSCIOWEGO**,93X,/,121X)
      END
      SUBROUTINE TTY
      LOGICAL GOT
      INTEGER AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,MESS,
     * TRACRH
      COMMON /SYSWIT/ AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,
     * MESS,TRACRH
      TT=7-TT
      IF(TT.NE.5) GO TO 5
      IF(CR.NE.0) RETURN
    1 PAUSE CR ?
      CALL ALLOT(5,GOT)
      IF(GOT) RETURN
      GO TO 1
    5 CALL SSWTCH(5,K)
      IF(K.EQ.2) RETURN
      CR=0
      CALL RLEASE(5)
      RETURN
      END
      SUBROUTINE ENTSORT(J)
      DIMENSION H(8),IWERS(7)
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER DTAB,DPILE,ITER,IVAR,IBAC,IREC
      INTEGER CLES(800),CALCUL(256)
      INTEGER POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      INTEGER MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,AXNIL,
     * AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      INTEGER AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,MESS,
     * TRACRH
     *,DB,DBWAS
      INTEGER ENTRE(80),ENTRE2(80),SORTIE(120),SORTI2(120)
      INTEGER LECMAX,IMPMAX,IENTRE,IENTR2,ISORTI,ISORT2,W
      INTEGER TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      INTEGER KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,ARG,
     * DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     *  COMPTE,LIMITE
      INTEGER WERSJA(7)
      INTEGER STSIZE,TOP,S(99)
      INTEGER LIMIT,LAST,LBUF(113)
      COMMON  TAB  /MSTACK/ PILE
      COMMON /RUNSYS/ DTAB,DPILE,ITER,IVAR,IBAC,IREC
      COMMON /AUXTAB/ CLES,CALCUL
      COMMON /DATSTR/ POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      COMMON /CONST/ MARGE,NBRE,LETTRE,CHIFFR,CARACT,
     * CNIL,CPOINT,AXNIL,AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      COMMON /SYSWIT/ AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,
     * MESS,TRACRH
     *,DB,DBWAS
      COMMON /IOBUF/ ENTRE,ENTRE2,SORTIE,SORTI2
      COMMON /IOCV/ LECMAX,IMPMAX,IENTRE,IENTR2,ISORTI,ISORT2,W
      COMMON /COMMUN/ TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      COMMON /AUXVAR/ KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,
     * ARG,DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     * COMPTE,LIMITE
      COMMON /STATYS/ ITERS,IVARS,IBACS,IRECS
      COMMON /WERSJA/ WERSJA
      COMMON /BLANK/ IBLANK,LEC120
      COMMON /TSTACK/ STSIZE,TOP,S
      COMMON /IOTR/ LIMIT,LAST,LBUF
      COMMON /SCHIND/ KBLANK,ILPAR,IRPAR,ISTAR,IQMARK,ICOMMA,ISLASH
      COMMON /LEVEL/ LEVEL
      COMMON /ENTSRT/ H
      GO TO (1,2,3,4,5,6,7,8,9,10,1111),J
C ** WCZYTANIE STANU INICJALNEGO **
    1 CALL TIME(CZAS)
      CALL DATE(DATA)
C TYLKO POD EGZEKUTOREM
CEXEC READ(5,555)H(1),H(2),I1,H(3),H(4),I2,H(5),H(6),I3,IRP,
CEXEC* H(7),H(8),I4
  555 FORMAT(3(2A8,I3),I3,2A8,I3)
      CALL SSWTCH(6,K)
      IF(K.EQ.1) W=8
      WRITE(W,9999)WERSJA,DTAB,DPILE,DATA,CZAS
 9999 FORMAT(7H1PROLOG,6X,7A4,5X,3HTAB,I6,3X,4HPILE,I6,8X,
     * 4HDATA,2X,A8,6X,4HCZAS,2X,A8,11X)
CEXEC WRITE(W,556)H(1),H(2),I1,H(3),H(4),I2,H(5),H(6),I3,IRP,
CEXEC* H(7),H(8),I4
  556 FORMAT(10H0 PLIKI : ,3(2A8,I3),I3,2A8,I3,32X)
CEXEC CALL FILE(1,H(1),I1,0)
CEXEC CALL FILE(2,H(3),I2,0)
      READ(1)DATA,CZAS,IWERS,ENTRE,SORTIE,IENTRE,ISORTI,ENTRE2,IENTR2,
     *SORTI2,ISORT2,
     1CLES,CALCUL,ITER,IIVAR,IBAC,IDTAB
     * ,LEVEL
      IVAR=DTAB-(IDTAB-IIVAR)
      IIVAR=IDTAB-IIVAR
      WRITE(W,557)DATA,CZAS,IWERS,ITER,IIVAR,IBAC
  557 FORMAT(30H STAN INICJALNY ZAPISANY DNIA  ,
     * A8,7H GODZ. ,A8,8H  PRZEZ ,7A4,33X,
     * /,5H   ( ,8HSLOWNIK:,I6,14H,PODSTAWIENIA:,I6,
     * 6H,STOS:,I6,2H ),68X)
      IF(ITER+IIVAR.GT.DTAB+MARGE.OR.IBAC.GT.DPILE+MARGE)
     *  CALL MESSAGE(4)
      READ(1)(TAB(I),I=1,ITER),(TAB(I),I=IVAR,DTAB),(PILE(I),I=1,IBAC)
      CALL RLEASE(1)
      DO 140 I=ITER,IVAR
  140 TAB(I)=0
      WRITE(W,559)
  559 FORMAT(25H STAN INICJALNY WCZYTANY.,96X,/,
     * 121X,/,121X,/,121X)
C *** A DIRTY PATCH TO ALLOW TAB SIZE CHANGES AFTER NETT!
C BOULOT AND $JOB ACTIVATION RECORDS ARE MODIFIED ***
      PILE(4) = DTAB+2
      PILE(8) = DTAB+2
      RETURN
C ** OPROZNIENIE BUFORA PRZED STOPEM **
    2 IF(DBWAS.EQ.0.OR.ISORT2.EQ.0) GO TO 22
      WRITE(9,12)(SORTI2(I),I=1,LECMAX)
      WRITE(W,13)(SORTI2(I),I=1,LECMAX)
   22 WRITE(W,11)(SORTIE(I),I=1,IMPMAX)
      IF(DBWAS.NE.0) ENDFILE 9
      RETURN
   11 FORMAT(1X,120A1)
   12 FORMAT(80A1)
   13 FORMAT(15H *DOUBLE*      ,80A1,15H      *DOUBLE* )
      RETURN
C ** UTWORZENIE KOPII STANU **
 3      IDTAB=IBAC
      IIVAR=IVAR
      IF(NETTO .EQ. 0) GO TO 600
      IBAC=10
      IVAR=DTAB-2
      NETTO = 0
600   CONTINUE
CEXEC CALL FILE(3,H(5),I3,IRP)
      CALL DATE(DATA)
      CALL TIME(CZAS)
      WRITE(3)DATA,CZAS,WERSJA,ENTRE,SORTIE,IENTRE,ISORTI,ENTRE2,IENTR2,
     *SORTI2,ISORT2,
     1CLES,CALCUL,ITER,IVAR,IBAC,DTAB
     *,LEVEL
      WRITE(3)(TAB(I),I=1,ITER),(TAB(I),I=IVAR,DTAB),(PILE(I),I=1,IBAC)
      ENDFILE 3
      REWIND 3
      WRITE(W,601) DATA,CZAS,WERSJA
  601 FORMAT(29H0**UTWORZONY STAN INICJALNY:  ,A8,2X,A8,2X,
     * 7A4,3H **,41X,/,121X)
      IBAC=IDTAB
       IVAR=IIVAR
      RETURN
C ** IMPRIMEE **
    4 CONTINUE
      WRITE(W,11)(TAB(TAB(CALCUL(ENTRE(I)+1))+CODE),I=1,LECMAX)
     * ,(IBLANK,I=1,LEC120)
      RETURN
    5 CONTINUE
      WRITE(W,11)(TAB(TAB(CALCUL(ENTRE2(I)+1))+CODE),I=1,LECMAX)
     * ,(IBLANK,I=1,LEC120)
      RETURN
C ** ENTREE **
    9 CONTINUE
      KF120 = 120-IENTRE
      WRITE(W,11)(TAB(TAB(CALCUL(ENTRE(I)+1))+CODE),I=1,IENTRE)
     * ,(IBLANK,I=1,KF120)
      RETURN
   10 CONTINUE
      KF120=120-IENTR2
      WRITE(W,11)(TAB(TAB(CALCUL(ENTRE2(I)+1))+CODE),I=1,IENTR2)
     * ,(IBLANK,I=1,KF120)
      RETURN
C ** LU I LUB **
    6 TERM1=TERM+1
      INST1=INST
      TERM=TERM+1
      CALL DESC
C***********************************************************************
C* VERIFICATION DE LA SYNTAXE..........................................*
C***********************************************************************
      IF (TAB(TERM).GT.NBRE.AND.TAB(TERM).LE.CHIFFR+2) GO TO 210
   15 T=2
      RETURN
C***********************************************************************
C* CHARGEMENT DU CARACTERE.............................................*
C***********************************************************************
  210 IF (TT.EQ.2) GO TO 50
      IENTRE=IENTRE+1
      IF(IENTRE.NE.LECMAX+1) GO TO 40
      IF(CLOCON.NE.0) CALL IMPHET
      READ(TT,30,END=8888) (ENTRE(I),I=1,LECMAX)
   30 FORMAT(80A1)
33    IF(BOOL.EQ.0) GO TO 32
      WRITE(W,11)(ENTRE(I),I=1,LECMAX)
     * ,(IBLANK,I=1,LEC120)
C   RSHIFT
   32 KF=0
      DO 3200 JF=1,LECMAX
        CALL COPY(1,KF,4,ENTRE(JF),1)
 3200   ENTRE(JF)=KF
      IENTRE=1
   40 I=CALCUL(ENTRE(IENTRE)+1)
      GO TO 90
50    IENTR2=IENTR2+1
      IF(IENTR2.NE.LECMAX+1) GO TO 80
      IF(CLOCON.NE.0) CALL IMPHET
      READ(TT,30,END=8888) (ENTRE2(I),I=1,LECMAX)
73    IF (BOOL.EQ.0) GO TO 72
      WRITE(W,11)(ENTRE2(I),I=1,LECMAX)
     * ,(IBLANK,I=1,LEC120)
C  RSHIFT
   72 KF=0
      DO 7200 JF=1,LECMAX
         CALL COPY(1,KF,4,ENTRE2(JF),1)
 7200   ENTRE2(JF) = KF
      IENTR2=1
80    I=CALCUL(ENTRE2(IENTR2)+1)
   90 IF (I.EQ.0) GO TO 15
      IF (I.EQ.2.AND.LUB.EQ.1) GO TO 210
      CLAUSR=I
      CLAUSA=TERM
      INSTA=INST
      CALL UNIFIE
      RETURN
C ** ECRIT **
    7 TERM=TERM+1
      CALL DESC
      IABT=TAB(TERM)-2
      IF(IABT .GE.0 .AND. IABT .LE. CHIFFR)GO TO 310
      T=2
      RETURN
  310 IF(EVAL.EQ.0) RETURN
      IF(DB.NE.0) GO TO 311
      IF(ISORTI.NE.IMPMAX) GO TO 3100
      IBACK=1
      GO TO 8000
 3100 ISORTI=ISORTI+1
      SORTIE(ISORTI)=TAB(TAB(TERM)+CODE)
      RETURN
  311 IF(ISORT2.NE.LECMAX) GO TO 3110
      IBACK=1
      GO TO 8000
 3110 ISORT2=ISORT2+1
      SORTI2(ISORT2) = TAB(TAB(TERM)+CODE)
      RETURN
C ** LIGNE **
    8 IF(EVAL.EQ.0) RETURN
      IBACK=0
 8000 CONTINUE
      CALL SSWTCH(6,K)
      IF(K.EQ.1) W=8
      IF(DB.NE.0) GO TO 88
      WRITE(W,11)(SORTIE(I),I=1,IMPMAX)
      DO 420 I=1,ISORTI
  420 SORTIE(I) = TAB(KBLANK+CODE)
      ISORTI=0
      IF(IBACK.NE.0) GO TO 3100
      RETURN
   88 CONTINUE
      DBWAS = 1

CEXEC WRITE(9,12)(SORTI2(I),I=1,LECMAX)
CEXEC GO TO 423
      WRITE(9,120)(SORTI2(I),I=1,LECMAX)
120    FORMAT(1X,80A1)
      WRITE(W,13) (SORTI2(I),I=1,LECMAX)
  423 DO 421 I=1,ISORT2
  421 SORTI2(I)=TAB(KBLANK+CODE)
      ISORT2=0
      IF(IBACK.NE.0) GO TO 3110
      RETURN
C ** BEDZIE PISANIE NA DOUBLE **
 1111 DBWAS =1
CEXEC CALL FILE(9,H(7),I4,30)
      RETURN
 8888 CALL MESSAGE(5)
      END
      SUBROUTINE IMPHET
      INTEGER DTAB,DPILE,ITER,IVAR,IBAC,IREC
      INTEGER LECMAX,IMPMAX,IENTRE,IENTR2,ISORTI,ISORT2,W
      COMMON /RUNSYS/ DTAB,DPILE,ITER,IVAR,IBAC,IREC
      COMMON /IOCV/ LECMAX,IMPMAX,IENTRE,IENTR2,ISORTI,ISORT2,W
      CALL TIME(CZAS)
      IIVAR = DTAB-IVAR
      WRITE(W,21) CZAS,ITER,IIVAR,IBAC
      RETURN
   21 FORMAT(65X,A8,2X,8HSLOWNIK:,I6,14H,PODSTAWIENIA:,I6,6H,STOS:,I6)
      END
      SUBROUTINE DESC
C PONIZEJ I=TERM, J=INST
C***********************************************************************
C* PARAMETRES= I= ADRESSE D'UN TERME,J= ADRESSE DE L'INSTANCE ASSOCIEE.*
C* RESULTATS= TERM= EST L'ADRESSE DU TERME FINAL DE LA COMPOSITION DES.*
C* SUBSTITUTIONS DU TERME D'ADRESSE I, INST EST L'ADRESSE DE L'INSTANCE*
C* ASSOCIEE............................................................*
C***********************************************************************
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,AXNIL,
     * AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      INTEGER TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      INTEGER KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,ARG,
     * DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     *  COMPTE,LIMITE
      COMMON  TAB  /MSTACK/ PILE
      COMMON /CONST/ MARGE,NBRE,LETTRE,CHIFFR,CARACT,
     * CNIL,CPOINT,AXNIL,AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      COMMON /COMMUN/ TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      COMMON /AUXVAR/ KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,
     * ARG,DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     * COMPTE,LIMITE
   20 IABA=TAB(TERM)
      IF(IABA.GE.0.OR.IABA.LE.NBRE) RETURN
      SUB=INST+IABA+IABA
      IABA=TAB(SUB)
      IF(IABA .EQ. 0)RETURN
      TERM=IABA
      INST=TAB(SUB-1)
      GO TO 20
      END
      SUBROUTINE SUBST
C WEPCHNIECIE NA STOS INFORMACJI O "NIELOKALNYM" PODSTAWIENIU NA
C ZMIENNA KTOREJ REPREZENTACJA W STREFIE PODSTAWIEN WSKAZANA JEST
C PRZEZ LOCAL
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER DTAB,DPILE,ITER,IVAR,IBAC,IREC
      INTEGER MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,AXNIL,
     * AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      INTEGER KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,ARG,
     * DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     *  COMPTE,LIMITE
      COMMON  TAB  /MSTACK/ PILE
      COMMON /RUNSYS/ DTAB,DPILE,ITER,IVAR,IBAC,IREC
      COMMON /CONST/ MARGE,NBRE,LETTRE,CHIFFR,CARACT,
     * CNIL,CPOINT,AXNIL,AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      COMMON /AUXVAR/ KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,
     * ARG,DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     * COMPTE,LIMITE
      IF(IREC-IBAC.LE.MARGE) CALL MESSAGE(2)
      PILE(IBAC)=-LOCAL
      IBAC=IBAC+1
      RETURN
      END
      SUBROUTINE UNIFIE
C***********************************************************************
C* PARAMETRES EXTERIEURS= CLAUSR= ADRESSE DU LITTERAL DE LA RESOLVANTE.*
C* A UNIFIER,INSTR= ADRESSE DE LA SUBSTITUTION ASSOCIEE,CLAUSA= ADRESSE*
C* DU LITTERAL DE L'AXIOME A UNIFIER,INSTR= ADRESSE DE LA SUBSTITUTION *
C* ASSOCIEE............................................................*
C* RESULTATS= UNIFE LES DEUX LITTERAUX.................................*
C* T= EST EGAL A 1 SI L'UNIFICATION EST IMPOSSIBLE,0 SINON.............*
C* NOTE= MEMES RESULTATS SI CLAUSA ET CLAUSR SONT LES ADRESSES DE DEUX.*
C* TERMES,.............................................................*
C***********************************************************************
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER DTAB,DPILE,ITER,IVAR,IBAC,IREC
      INTEGER CLES(800),CALCUL(256)
      INTEGER POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      INTEGER MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,AXNIL,
     * AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      INTEGER AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,MESS,
     * TRACRH
      INTEGER TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      INTEGER PILMIN,TABMIN
      INTEGER KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,ARG,
     * DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     *  COMPTE,LIMITE
      COMMON  TAB  /MSTACK/ PILE
      COMMON /RUNSYS/ DTAB,DPILE,ITER,IVAR,IBAC,IREC
      COMMON /AUXTAB/ CLES,CALCUL
      COMMON /DATSTR/ POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      COMMON /CONST/ MARGE,NBRE,LETTRE,CHIFFR,CARACT,
     * CNIL,CPOINT,AXNIL,AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      COMMON /SYSWIT/ AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,
     * MESS,TRACRH
      COMMON /COMMUN/ TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      COMMON /MINMIN/PILMIN,TABMIN
      COMMON /AUXVAR/ KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,
     * ARG,DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     * COMPTE,LIMITE
C
C 5-KI NA STOSIE: ILOSC NIE ZUNIFIKOWANYCH JESZCZE ARGUMENTOW,
C STARE: CLAUSA,INSTA,CLAUSR,INSTR  (0 JESLI NIE ZMIENIONE)
C
      T=0
      IREC=DPILE
      PILE(IREC)=0
   10 IF(IREC-IBAC.LE.MARGE) CALL MESSAGE(2)
      IF(IREC-IBAC.LT.PILMIN) PILMIN=IREC-IBAC
      IABA=TAB(CLAUSA)
      IABR=TAB(CLAUSR)
      IF(IABA.LE.0.AND.IABA.GT.NBRE) GO TO 15
      IF(IABA.EQ.IABR) GO TO 20
      IF(IABR.GT.0.OR.IABR.LE.NBRE) GO TO 80
      GO TO 50
C **** ZMIENNA PO STRONIE NAGLOWKA ****
   15 IF(IABA.NE.0.AND.(IABR.LT.0.AND.IABR.GT.NBRE)) GO TO 40
      TERM=CLAUSA
      INST=INSTA
      CALL DESC
      IF(TAB(CLAUSR).NE.TAB(TERM)) GO TO 14
C WARTOSC ZMIENNEJ NAGLOWKA TERMEM LITERALU
   11 PILE((IREC-1))=CLAUSA
      PILE((IREC-2))=INSTA
      PILE((IREC-3))=0
      PILE((IREC-4))=0
      CLAUSA=TERM
      INSTA=INST
      IREC=IREC-5
C ILOSC ARGUMENTOW TERMU
      KF = TAB(TERM)
      IF(KF.GE.0) GO TO 13
      PILE(IREC)=0
      GO TO 60
   13 PILE(IREC) = TAB(KF+POIDS)
      GO TO 60
C NIE 11,ALE MOZE WARTOSCIA ZMIENNEJ NAGLOWKA JEST ZMIENNA
   14 KF=TAB(TERM)
      IF(KF.GT.0.OR.KF.LE.NBRE) GO TO 80
C PODSTAWIENIE NA ZMIENNA NAGLOWKA
      LOCAL=INST+KF+KF
      TAB(LOCAL)=CLAUSR
      TAB(LOCAL-1)=INSTR
      IF(LOCAL.GE.LIMITE) CALL SUBST
C CLAUSR PRZED NASTEPNZM TERMEM W LITERALE
      IF(TAB(CLAUSR).LT.0) GO TO 60
      RESTER=CLAUSR
      CALL SAUT
      CLAUSR=RESTER-1
      GO TO 60
C **** TEN SAM TERM PO STRONIE NAGLOWKA I LITERALU ****
   20 KFA = TAB(CLAUSA)
      IF(KFA.LT.0) GO TO 60
C MODYFIKACJA LICZNIKA ARGUMENTOW
      PILE(IREC) = PILE(IREC) + TAB(KFA+POIDS)
      GO TO 60
C **** ZMIENNE PO STRONIE NAGLOWKA I LITERALU ****
40    TERM=CLAUSA
      INST=INSTA
      CALL DESC
      TERM1=TERM
      INST1=INST
      TERM=CLAUSR
      INST=INSTR
      CALL DESC
      IABR = TAB(TERM)
      IABA = TAB(TERM1)
C 60 : TO SAMO WYSTAPIENIE TERMU LUB ZMIENNE O TYM SAMYM NUMERZE O R A Z
C  WSPOLNA STREFA ZMIENNYCH
C 45 : NIE,I ZMIENNA PO STRONIE LITERALU
C 42 : NIE,I ROZNE WYSTAPIENIA TEGO SAMEGO TERMU (?)
C 80 : NIE,I NIE-ZMIENNA W NAGLOWKU
C 46 : NIE,I ZMIENNA W NAGLOWKU
      IF(INST.NE.INST1) GO TO 400
      IF(TERM.EQ.TERM1) GO TO 60
      IF(IABA.EQ.IABR.AND.IABR.LT.0) GO TO 60
  400 IF(IABR.GT.0) GO TO 410
      IF(IABR.EQ.0) GO TO 46
      IF(IABR.GT.NBRE) GO TO 44
  410 IF(IABA.EQ.IABR) GO TO 42
      IF(IABA.GT.0) GO TO 80
      IF(IABA.LE.NBRE) GO TO 80
C PODSTAWIENIE NA ZMIENNA W NAGLOWKU
   46 LOCAL=INST1+IABA+IABA
      TAB(LOCAL)=TERM
      TAB(LOCAL-1)=INST
      IF(LOCAL.GE.LIMITE) CALL SUBST
      GO TO 60
C PRZEJSCIE DO UNIFIKACJI TERMOW BEDACYCH WARTOSCIAMI
C  ZMIENNYCH NAGLOWKA I LITERALU
   42 PILE((IREC-1))=CLAUSA
      PILE((IREC-2))=INSTA
      PILE((IREC-3))=CLAUSR
      PILE((IREC-4))=INSTR
      CLAUSA=TERM1
      INSTA=INST1
      CLAUSR=TERM
      INSTR=INST
      IREC=IREC-5
C USTAWIENIE ILOSCI ARGUMENTOW TERMU
      KF=TAB(TERM)
      IF(KF.GE.0) GO TO 43
      PILE(IREC)=0
      GO TO 60
   43 PILE(IREC) = TAB(KF+POIDS)
      GO TO 60
C PODSTAWIENIE NA ZMIENNA LITERALU
   44 LOCAL=INST+IABR+IABR
      TAB(LOCAL)=TERM1
      TAB(LOCAL-1)=INST1
      IF(LOCAL.GE.LIMITE) CALL SUBST
      GO TO 60
C **** ZMIENNA PO STRONIE LITERALU,ALE NIE NAGLOWKA ****
50    TERM=CLAUSR
      INST=INSTR
      CALL DESC
      IABR = TAB(TERM)
      IF(TAB(CLAUSA).EQ.IABR) GO TO 54
      IF(IABR.GT.0.OR.IABR.LE.NBRE) GO TO 80
C PODSTAWIENIE NA ZMIENNA W LITERALE
      LOCAL=INST+IABR+IABR
      TAB(LOCAL)=CLAUSA
      TAB(LOCAL-1)=INSTA
      IF(LOCAL.GE.LIMITE) CALL SUBST
C CLAUSA PRZED NASTEPNYM TERMEM W NAGLOWKU
      IF(TAB(CLAUSA).LT.0) GO TO 60
      RESTER=CLAUSA
      CALL SAUT
      CLAUSA=RESTER-1
      GO TO 60
C WARTOSC ZMIENNEJ LITERALU ROWNA TERMOWI NAGLOWKA
   54 PILE((IREC-3))=CLAUSR
      PILE((IREC-4))=INSTR
      PILE((IREC-2))=0
      PILE((IREC-1))=0
      CLAUSR=TERM
      INSTR=INST
      IREC=IREC-5
      KF=TAB(TERM)
      IF(KF.GE.0) GO TO 58
      PILE(IREC)=0
      GO TO 60
   58 PILE(IREC) = TAB(KF+POIDS)
C **** UNIFIKACJA ARGUMENTOW WLASNIE UNIFIKOWANYCH TERMOW LUB POWROT Z
C   REKURSJI ****
   60 IF(PILE(IREC).NE.0) GO TO 74
C NA TYM POZIOMIE WSZYSTKO JEST JUZ ZUNIFIKOWANE
      IF(IREC.EQ.DPILE) RETURN
      IREC=IREC+5
      KF=PILE(IREC-1)
      IF(KF.EQ.0) GO TO 70
      CLAUSA=KF
      INSTA=PILE( IREC-2)
   70  KF=PILE(IREC-3)
      IF(KF.EQ.0) GO TO 60
      CLAUSR=KF
      INSTR=PILE( IREC-4)
      GO TO 60
C CLAUSA I CLAUSR NA POCZATKU NASTEPNYCH TERMOW (ARGUMENTOW)
C I ZMNIEJSZENIE LICZNIKA ARGUMENTOW
   74 CLAUSA=CLAUSA+1
      CLAUSR=CLAUSR+1
      PILE(IREC)=(PILE( IREC)-1)
      GO TO 10
C **** NIE DA SIE ZUNIFIKOWAC ****
   80 T=1
      DO 82 M=IREC,DPILE,1
   82 PILE(M)=0
      IREC=DPILE
      RETURN
      END
      SUBROUTINE SAUT
C PRZESTAWIA RESTER Z PREDYKATU NA NASTEPNY (W POSTACI PREFIKSOWEJ)
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      INTEGER KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,ARG,
     * DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     *  COMPTE,LIMITE
      COMMON  TAB  /MSTACK/ PILE
      COMMON /DATSTR/ POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      COMMON /AUXVAR/ KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,
     * ARG,DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     * COMPTE,LIMITE
      COMPTE=0
C COMPTE ZLICZA SUMARYCZNA ILOSC ARGUMENTOW
   10 IABR=TAB(RESTER)
      IF(IABR .GE. 0)COMPTE=COMPTE+TAB(IABR+POIDS)
      RESTER=RESTER+1
      IF (COMPTE.EQ.0) RETURN
      COMPTE=COMPTE-1
      GO TO 10
      END
      SUBROUTINE AJOUT
C  PREDYKATY: AJOUT,AJOUTB,AJOUTC
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER DTAB,DPILE,ITER,IVAR,IBAC,IREC
      INTEGER CLES(800),CALCUL(256)
      INTEGER POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      INTEGER MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,AXNIL,
     * AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      INTEGER AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,MESS,
     * TRACRH
      INTEGER TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      INTEGER PILMIN,TABMIN
      INTEGER KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,ARG,
     * DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     *  COMPTE,LIMITE
      COMMON  TAB  /MSTACK/ PILE
      COMMON /MINMIN/ PILMIN,TABMIN
      COMMON /RUNSYS/ DTAB,DPILE,ITER,IVAR,IBAC,IREC
      COMMON /AUXTAB/ CLES,CALCUL
      COMMON /DATSTR/ POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      COMMON /CONST/ MARGE,NBRE,LETTRE,CHIFFR,CARACT,
     * CNIL,CPOINT,AXNIL,AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      COMMON /SYSWIT/ AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,
     * MESS,TRACRH
      COMMON /COMMUN/ TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      COMMON /AUXVAR/ KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,
     * ARG,DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     * COMPTE,LIMITE
C***********************************************************************
C INICJALIZACJA:
C CLAUSR,INSTR - ADRES KROPKI PIERWSZEGO LITERALU ARGUMENTU I ADRES
C  STREFY ZMIENNYCH JEGO KLAUZULI
C DEBUT - POCZATEK POLA ROZWAZANEJ KLAUZULI W TAB
C SEPAR - WIERZCHOLEK STOSU DLA REKURSJI W PILE,OD SEPAR+1 DO DPILE
C      POLE ZMIENNYCH KLAUZULI
C ITER - WSKAZNIK W STOSIE REKURSJI
C IREC - WSKAZNIK W TAB
C* INITIALISATION DES POINTEURS........................................*
C***********************************************************************
      CLAUSR=TERM+1
      INSTR=INST
      DEBUT=ITER
      ITER=ITER+1
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
      ISTOR=DPILE
      SEPAR=DPILE+NBRE
      IREC=SEPAR
      IF(IREC-IBAC.LE.MARGE) CALL MESSAGE(2)
      IF(IREC-IBAC.LT.PILMIN) PILMIN=IREC-IBAC
C***********************************************************************
C KONTROLA POPRAWNOSCI I WPISANIE POCZATKU KLAUZULI
C* VERIFICATION ET ECRITURE DE LA CLAUSE...............................*
C***********************************************************************
      TERM=CLAUSR
      INST=INSTR
      CALL DESC
C POSZUKIWANIE KROPKI
      IF(TAB(TERM).EQ.CPOINT) GO TO 40
C***********************************************************************
C BLAD SYNTAKTYCZNY: WYZEROWANIE TAB,POWROT
C* ERREUR SYNTAXIQUE REMISE A ZERO....................................
C*********************************************************************
   30 T=2
C #   #   #   ##     ##   ##   #
      IF(ITER.EQ.DEBUT) RETURN
   31 MI=ITER-1
      DO 32 I=DEBUT,MI,1
   32 TAB(I)=0
      ITER=DEBUT
      RETURN
C***********************************************************************
C* ECRITURE DU POINT...................................................*
C WPISANIE KROPKI
C***********************************************************************
   40 IF(IVAR-ITER.LE.MARGE) CALL MESSAGE(1)
      TAB(ITER) = CPOINT
      ITER=ITER+1
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
C***********************************************************************
C ZAPAMIETANIE ADRESU PIERWSZEGO ARGUMENTU KROPKI
C* STOCKAGE DE L'ADRESSE DU PREMIER ARGUMENT DU POINT..................*
C***********************************************************************
      TERM1=TERM+1
      INST1=INST
C***********************************************************************
C KONTROLA POPRAWNOSCI I WPISANIE PIERWSZEGO LITERALU
C* VERIFICATION ET ECRITURE DU PREMIER LITTERAL........................*
C***********************************************************************
      TERM=TERM+1
      CALL DESC
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
C JESLI TERM NIE JEST ADRESEM ZNAKU - BLAD
      IF(TAB(TERM).NE.PLUS.AND.TAB(TERM).NE.MOINS) GO TO 30
      TERM=TERM+1
      CALL DESC
C JESLI PREDYKAT PIERWSZEGO LITERALU JEST ZMIENNA - BLAD
      IF(TAB(TERM).LE.0) GO TO 30
      TERM=TERM1
      INST=INST1
C WPISANIE PREDYKATU DO TAB
      CALL AJOULI
C JESLI PREDYKAT JEST OBLICZALNYM - BLAD
      IF (TAB(TAB(DEBUT+3)+PRED).LT.0) GO TO 30
C***********************************************************************
C WERYFIKACJA I WPISANIE DALSZYCH LITERALOW
C* VERIFICATION ET ECRITURE DES AUTRES LITTERAUX.......................*
C***********************************************************************
62    TERM=TERM+1
C ZNOWU KROPKA ALBO KONCZACY NIL ALBO BLAD
      CALL DESC
      IF(TAB(TERM).NE.CPOINT) GO TO 80
      IF(IVAR-ITER.LE.MARGE) CALL MESSAGE(1)
      TAB(ITER) = CPOINT
      ITER=ITER+1
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
      TERM1=TERM+1
      INST1=INST
      TERM=TERM+1
      CALL DESC
C TERAZ ZNAK KOLEJNEGO LITERALU
      IF(TAB(TERM).NE.PLUS.AND.TAB(TERM).NE.MOINS) GO TO 30
      TERM=TERM1
      INST=INST1
C WPISANIE PREDYKATU DO TQB
      CALL AJOULI
      GO TO 62
   80 IF(TAB(TERM).NE.CNIL) GO TO 30
C***********************************************************************
C KONIEC KLAUZULI
C* FIN DE CLAUSE.......................................................*
C***********************************************************************
      IF(EVAL.EQ.0) GO TO 31
      IF(IVAR-ITER.LE.MARGE) CALL MESSAGE(1)
C WPISANIE KONCZACEGO NILA I LICZBY ZMIENNYCH KLAUZULI
      TAB(ITER)=CNIL
      ITER=ITER+1
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
      TAB(DEBUT)=DPILE-ISTOR
C J - ADRES PREDYKATU LITERALU NAGLOWKA  DOLACZONEJ KLAUZULI
      J=TAB(DEBUT+3)+PRED
      IF(TAB(J).NE.0) GO TO 105
      TAB(J)=ITER
      ITER=ITER+2
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
C I - ADRES LISTY KLAUZUL O TYM SAMYM NAGLOWKU CO DOLACZANA
  105 IF(TAB(DEBUT+2).NE.PLUS) GO TO 120
      I=TAB(J)+ACPL
      GO TO 130
  120 I=TAB(J)+ACMO
  130 IF(AJB.EQ.1.OR.AJC.EQ.1) GO TO 140
C MODYFIKACJA LIST WYBOROW (AJOUT)
C DOLACZANA KLAUZULE OPISUJE DUBLET ITER+CLO,ITER+SUIV
      TAB(ITER+SUIV)=TAB(I)
      TAB(I)=ITER+CLO
      TAB(ITER+CLO)=DEBUT+1
      ITER=ITER+2
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
      RETURN
C AJOUTB LUB AJOUTC
  140 IF(NOP.EQ.I.AND.TAB(I).NE.0) GO TO 170
      IF (AJC.EQ.1) GO TO 145
C SKASOWANIE KLAUZUL DODANYCH UPRZEDNIO,WSTAWIENIE NOP
C**PAS D'AJOUT PAR LE BAS * SUPPRIME LES CLAUSES AJOUTEES PRECEDEMMENT
C**  QUAND NOP EST MAL POSITIONNE.....................................
      TAB(I)=NIL
      NOP=I
C KONIEC MODYFIKACJI,POSZUKIWANIE KONCA KLAUZULI - BAS
C** FIN DE MODIFICATION ..............................................
  145 IF(TAB(I).EQ.0) TAB(I)=ITER
  150 BAS=TAB(I)+SUIV
      IF(TAB(BAS).EQ.0) GO TO 160
      I=BAS
      GO TO 150
  160 BAS=TAB(I)
C MODYFIKACJA LIST WYBOROW
  170 TAB(BAS+SUIV)=ITER
      TAB(ITER+CLO)=DEBUT+1
      TAB(ITER+SUIV)=NIL
      BAS=ITER
      ITER=ITER+2
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
      RETURN
      END
      SUBROUTINE AJOULI
C***********************************************************************
C PARAMETRY ZEWNETRZNE :
C TERM - ADRES ZNAKU PREDYKATU
C INST - ADRES STREFY ZMIENNYCH JEGO KLAUZULI
C* PARAMETRES EXTERIEURS= TERM,ADRESSE DU SIGNE D'UN PREDICAT,.........*
C* INST,INSTANCE ASSOCIEE..............................................*
C* RESULTATS= AJOUTE UN LITTERAL OU UN ARBRE DANS LA ZONE DES TERMES...*
C***********************************************************************
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER TABMIN,PILMIN
      INTEGER DTAB,DPILE,ITER,IVAR,IBAC,IREC
      INTEGER CLES(800),CALCUL(256)
      INTEGER POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      INTEGER MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,AXNIL,
     * AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      INTEGER AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,MESS,
     * TRACRH
      INTEGER TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      INTEGER KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,ARG,
     * DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     *  COMPTE,LIMITE

      COMMON /MINMIN/ PILMIN,TABMIN
      COMMON TAB  /MSTACK/ PILE
      COMMON /RUNSYS/ DTAB,DPILE,ITER,IVAR,IBAC,IREC
      COMMON /AUXTAB/ CLES,CALCUL
      COMMON /DATSTR/ POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      COMMON /CONST/ MARGE,NBRE,LETTRE,CHIFFR,CARACT,
     * CNIL,CPOINT,AXNIL,AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      COMMON /SYSWIT/ AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,
     * MESS,TRACRH
      COMMON /COMMUN/ TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      COMMON /AUXVAR/ KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,
     * ARG,DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     * COMPTE,LIMITE
C IREC - WSKAZNIK W STOSIE REKURSJI
C NA STOS WCHODZA TROJKI: LICZBA ARGUMENTOW,ADRES TERMU,ADRES STREFY
C    ZMIENNYCH
      PILE(IREC)=0
      PILE((IREC-1))=TERM
      PILE((IREC-2))=INST
   30 IF(TAB(TERM).LT.0) GO TO 40
C WPISANIE LICZBY ARGUMENTOW PREDYKATU
      PILE(IREC)=PILE(IREC)+TAB(TAB(TERM)+POIDS)
      GO TO 48
C TERM JEST ZMIENNA LUB LICZBA
   40 IF(TAB(TERM).LE.NBRE) GO TO 48
      PILE(IREC-1)=TERM
      PILE((IREC-2))=INST
C  CZY ZMIENNA  ZWIAZANA ?
      CALL DESC
      IF(TAB(TERM).LE.NBRE) GO TO 140
      IF(TAB(TERM).LT.0) GO TO 50
      IF(IREC-IBAC.LE.MARGE) CALL MESSAGE(2)
C KOLEJNA TROJKA NA STOS
      IREC=IREC-3
      IF(IREC-IBAC.LT.PILMIN) PILMIN= IREC-IBAC
      PILE(IREC)=TAB(TAB(TERM)+POIDS)
      PILE((IREC-1))=TERM
      PILE((IREC-2))=INST
C LICZBA "BEZPOSREDNIO",WPISANIE,PROBA ZAKONCZENIA
   48 IF(IVAR-ITER.LE.MARGE) CALL MESSAGE(1)
      TAB(ITER)=TAB(TERM)
      ITER=ITER+1
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
C LICZBA "ZWIAZANA",WPISANIE DO TAB,USTAWIENIE TERM I INST,PROBA
C   ZAKONCZENIA
      GO TO 90
  140 IF(IVAR-ITER.LE.MARGE) CALL MESSAGE(1)
      TAB(ITER)=TAB(TERM)
      ITER=ITER+1
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
      GO TO 89
C***********************************************************************
C PRZYPADEK ZMIENNEJ
C K I ISTOR PORUSZAJA SIE W STREFIE ZMIENNYCH
C* CAS D'UNE VARIABLE..................................................*
C***********************************************************************
   50 J=INST+2*TAB(TERM)
      K=DPILE
   52 CONTINUE
      IF(K.NE.ISTOR) GO TO 70
C***********************************************************************
C ZAPAMIETANIE ZMIENNEJ N A POZYCJI ISTOR
C* STOCKAGE DE LA VARIABLE.............................................*
C***********************************************************************
      PILE(K)=J
      ISTOR=ISTOR-1
C***********************************************************************
C SPISANIE ZMIENNEJ DO TAB (KOLEJNO -1,-2,...)
C* ECRITURE DE LA VARIABLE.............................................*
C***********************************************************************
   62 IF(IVAR-ITER.LE.MARGE) CALL MESSAGE(1)
      TAB(ITER)=K-DPILE-1
      ITER=ITER+1
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
      GO TO 89
C***********************************************************************
C* RECHERCHE DE LA VARIABLE............................................*
C***********************************************************************
   70 IF(PILE(K).EQ.J) GO TO 62
      K=K-1
      GO TO 52
C***********************************************************************
C MODYFIKACJA STANU REKURSJI
C GDY LISTA ARGUMENTOW PUSTA - PROBA ZAKONCZENIA,WPP- DO KOLEJNEGO ARG.
C* REPOSITIONNEMENT DANS LA PILE DE RECURSIVITE........................*
C***********************************************************************
   89 TERM=PILE(IREC-1)
      INST=PILE(IREC-2)
C USTAWIONO TERM I INST,PROBA ZAKONCZENIA
   90 CONTINUE
      IF(PILE(IREC).EQ.0) GO TO 110
      PILE(IREC)=PILE(IREC)-1
      TERM=TERM+1
      PILE((IREC-1))=TERM
      GO TO 30
  110 IF(IREC.EQ.SEPAR) GO TO 130
C PRZEJSCIE W GORE STOSU
      IREC=IREC+3
      GO TO 89
C KONIEC REKURSJI
  130 TERM=PILE( IREC-1)
      INST=PILE( IREC-2)
      RETURN
      END
      SUBROUTINE ARITH(I)
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,AXNIL,
     * AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      INTEGER TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      INTEGER KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,ARG,
     * DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     *  COMPTE,LIMITE
      COMMON  TAB  /MSTACK/ PILE
      COMMON /CONST/ MARGE,NBRE,LETTRE,CHIFFR,CARACT,
     * CNIL,CPOINT,AXNIL,AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      COMMON /COMMUN/ TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      COMMON /AUXVAR/ KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,
     * ARG,DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     * COMPTE,LIMITE
      KFCHIF=CHIFFR+2
      KFLETT=LETTRE+2
      CLAUSR=TERM
C PIERWSZY ARGUMENT -REPR.LICZBY LUB CYFRA
      INSTR=INST
      TERM=CLAUSR+1
      INST=INSTR
      CALL DESC
      KF=TAB(TERM)
      EXPLOR=KF-NBRE
      IF(EXPLOR.LE.0) GO TO 20
      IF(KF.GT.KFLETT.AND.KF.LE.KFCHIF) GO TO 15
   10 T=2
      RETURN
   15 CONTINUE
      EXPLOR= -(KF-LETTRE-8)/6
C DRUGI ARGUMENT - JAK PIERWSZY
20    TERM=CLAUSR+2
      INST=INSTR
      CALL DESC
      KF=TAB(TERM)
      SEPAR=KF-NBRE
      IF(SEPAR.LE.0) GO TO 30
      IF(KF.LE.KFLETT.OR.KF.GT.KFCHIF) GO TO 10
      SEPAR= -(KF-LETTRE -8) /6
C TRZECI ARGUMENT - TYLKO TEN MOZE BYC ZMIENNA NIEZWIAZANA
30    TERM=CLAUSR+3
      INST=INSTR
      CALL DESC
      KF=TAB(TERM)
C CYFRA ?
      IF(KF.LE.0) GO TO 40
      IF(KF.LE.KFLETT.OR.KF.GT.KFCHIF) GO TO 10
      J= -(KF-LETTRE-8)/6
C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
   40 CONTINUE
      GO TO (60,70,80,90,100),I
60    EXPLOR=EXPLOR+SEPAR+NBRE
      GO TO 110
70     IF(EXPLOR .GT. SEPAR ) GO TO 10
      EXPLOR=EXPLOR-SEPAR+NBRE
      GO TO 110
80    EXPLOR=-EXPLOR/SEPAR+NBRE
      GO TO 110
90    EXPLOR=MOD(EXPLOR,SEPAR)+NBRE
      GO TO 110
100   EXPLOR=-EXPLOR*SEPAR+NBRE
110   IF(EXPLOR.GT.NBRE-10) EXPLOR=LETTRE+6-(EXPLOR-NBRE)*6
C * *   * *   * *
      J=KF
C LICZBA ?
      IF(J.GT.NBRE) GO TO 111
      IF(J.GT.NBRE -10) J=LETTRE+6-(J-NBRE)*6
      GO TO 119
C ZMIENNA ?
  111 IF(J.LE.0) GO TO 120
C *   **    **     *
C CYFRA !
      J=(J/6)*6 +2
C POROWNANIE
  119 IF(J.EQ.EXPLOR) RETURN
      T=1
      RETURN
C TRZECI ARGUMENT BYL ZMIENNA WOLNA
  120 LOCAL=INST+J+J
      IF(EXPLOR.GT.0) GO TO 130
      TAB(LOCAL) = LOCAL-1
      TAB(LOCAL-1)=EXPLOR
      IF(LOCAL.GE.LIMITE) CALL SUBST
      RETURN
  130 CONTINUE
      TAB(LOCAL)=EXPLOR
      TAB(LOCAL-1)=0
      IF(LOCAL.GE.LIMITE) CALL SUBST
      RETURN
      END
      SUBROUTINE SUPP
      INTEGER TAB(&TAB),PILE(&PILE)
       INTEGER PILMIN,TABMIN
      INTEGER DTAB,DPILE,ITER,IVAR,IBAC,IREC
      INTEGER CLES(800),CALCUL(256)
      INTEGER POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      INTEGER MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,AXNIL,
     * AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      INTEGER AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,MESS,
     * TRACRH
      INTEGER TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      INTEGER KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,ARG,
     * DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     *  COMPTE,LIMITE
      COMMON  TAB  /MSTACK/ PILE
      COMMON/MINMIN/ PILMIN,TABMIN
      COMMON /RUNSYS/ DTAB,DPILE,ITER,IVAR,IBAC,IREC
      COMMON /AUXTAB/ CLES,CALCUL
      COMMON /DATSTR/ POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      COMMON /CONST/ MARGE,NBRE,LETTRE,CHIFFR,CARACT,
     * CNIL,CPOINT,AXNIL,AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      COMMON /SYSWIT/ AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,
     * MESS,TRACRH
      COMMON /COMMUN/ TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      COMMON /AUXVAR/ KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,
     * ARG,DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     * COMPTE,LIMITE
C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
C SKUTKUJE TYLKO JESLI ARGUMENT DA SIE UZGODNIC Z  P I E R W S Z A
C  KLAUZULA O TYM NAGLOWKU
      TERM=TERM+1
      CALL DESC
C  TERM: ARGUMENT SUPP
      IF(TAB(TERM).EQ.CPOINT) GO TO 15
   20 T=2
      RETURN
   15 CONTINUE
      CLAUSR=TERM
      INSTR=INST
      TERM=TERM+1
      CALL DESC
C TERM: PIERWSZY ARGUMENT KROPKI (ZNAK NAGLOWKA)
      IF(TAB(TERM).NE.PLUS) GO TO 10
      I=ACPL
      GO TO 30
   10 IF(TAB(TERM).NE.MOINS) GO TO 20
      I=ACMO
30    TERM=TERM+1
      CALL DESC
C TERM: PREDYKAT NAGLOWKA
      J=TAB(TAB(TERM)+PRED)
      IF(J.NE.0) GO TO 50
   40 CONTINUE
      T=1
      RETURN
C PROBA UNIFIKACJI. CLAUSA: KLAUZULA, K: ILOSC JEJ ZMIENNYCH
 50   IF (TAB(J+I).EQ.NIL) GO TO 40
      CLAUSA=TAB(TAB(J+I)+CLO)
      K=TAB(CLAUSA-1)
      INSTA=IVAR+2
      LIMITE=IVAR
      CALL UNIFIE
      IF(T.EQ.0) GO TO 100
C ZAWOD: ODKRECENIE EFEKTOW UNIFIE
   60 IBAC=IBAC-1
      KF=PILE(IBAC)
      IF(KF.GE.0) GO TO 80
C ODKRECENIE PODSTAWIENIA "NIELOKALNEGO"
      TAB(-KF) = 0
      TAB(-KF-1) =0
      GO TO 60
C  CZYSZCZENIE STREFY ZMIENNYCH
   80 MI=IVAR-2*K
      DO 90 M=MI,IVAR
   90 TAB(M)=0
C ZWIEKSZENIE IBAC,BO POD 60 SPADL ZA NISKO
      IBAC=IBAC+1
      IF(IREC-IBAC.LT.PILMIN) PILMIN=IREC-IBAC
      RETURN
C SUKCES: ZACHOWANIE STREFY ZMIENNYCH USUWANEJ KLAUZULI (BYC MOZE
C  POTRZEBNA ZE WZGLEDU NA PODSTAWIENIA ZMIENNYCH W SUPP ... )
  100 IVAR=IVAR-K-K
      IF(IVAR-ITER.LE.MARGE) CALL MESSAGE(1)
C UNIEDOSTEPNIENIE KLAUZULI
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
      TAB(J+I)=TAB(TAB(J+I)+SUIV)
      RETURN
      END
      SUBROUTINE SLASH1
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER DTAB,DPILE,ITER,IVAR,IBAC,IREC
      INTEGER TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      COMMON  TAB  /MSTACK/ PILE
      COMMON /RUNSYS/ DTAB,DPILE,ITER,IVAR,IBAC,IREC
      COMMON /COMMUN/ TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      IF(EVAL.EQ.0) RETURN
      KF=IBAC-4
      J=PILE(KF)+3
      PILE(J-2) =0
      I=J
    1 IF(I.EQ.KF) GO TO 10
      IF(PILE(I).GE.0) GO TO 2
      PILE(J) = PILE(I)
      J=J+1
      I=I+1
      GO TO 1
    2 I=I+4
      GO TO 1
   10 IF(J.EQ.KF) RETURN
      PILE(J)=PILE(KF)
      PILE(J+1)=PILE(KF+1)
      PILE(J+2)=PILE(KF+2)
      PILE(J+3)= PILE(KF+3)
      IBAC=J+4
      RETURN
      END
      SUBROUTINE SLASH2
      INTEGER PILMIN,TABMIN
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER DTAB,DPILE,ITER,IVAR,IBAC,IREC
      INTEGER CLES(800),CALCUL(256)
      INTEGER POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      INTEGER MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,AXNIL,
     * AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      INTEGER AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,MESS,
     * TRACRH
      INTEGER TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      INTEGER KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,ARG,
     * DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     *  COMPTE,LIMITE
      COMMON/MINMIN/ PILMIN,TABMIN
      COMMON  TAB  /MSTACK/ PILE
      COMMON /RUNSYS/ DTAB,DPILE,ITER,IVAR,IBAC,IREC
      COMMON /AUXTAB/ CLES,CALCUL
      COMMON /DATSTR/ POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      COMMON /CONST/ MARGE,NBRE,LETTRE,CHIFFR,CARACT,
     * CNIL,CPOINT,AXNIL,AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      COMMON /SYSWIT/ AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,
     * MESS,TRACRH
      COMMON /COMMUN/ TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      COMMON /AUXVAR/ KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,
     * ARG,DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     * COMPTE,LIMITE
C SPRAWDZENIE POCZATKU ARGUMENTU
      K=TERM+1
      L=INST
      TERM=K
      CALL DESC
      IF(TAB(TERM).EQ.PLUS.OR.TAB(TERM).EQ.MOINS) GO TO 10
C BLAD
      T=2
      RETURN
C***********************************************************************
C* RECHERCHE DE L'ANCETRE..............................................*
C***********************************************************************
   10 I=PILE( IBAC-4)
   12 IF(I.NE.0) GO TO 30
C NIE MA DOBREGO POPRZEDNIKA
      T=1
      RETURN
   30 CLAUSA=PILE( I)+1
      INSTA=PILE( PILE( I-1)+2)
      CLAUSR=K
      INSTR=L
      LIMITE=IVAR
C ( NIE MA TU ZMIENNYCH LOKALNYCH)
   32 CALL UNIFIE
      IF(T.NE.1) GO TO 70
C***********************************************************************
C* REMISE A ZERO DES SUBSTITUTIONS ....................................*
C***********************************************************************
C TO NIE TEN POPRZEDNIK
   40 IBAC=IBAC-1
      T=0
      KIB=PILE(IBAC)
      IF(KIB.GE.0) GO TO 60
      TAB(-KIB) =0
      TAB(-KIB-1)=0
      GO TO 40
   60 IBAC=IBAC+1
      IF(IREC-IBAC.LT.PILMIN) PILMIN=IREC-IBAC
      I=PILE( I-1)
      GO TO 12
C***********************************************************************
C* L'ANCETRE CORRESPONDANT EST TROUVE..................................*
C***********************************************************************
C ** WOLANIE Z PLUSEM MOZE WPLYNAC NA ZMIENNE POPRZEDNIKA **
   70 DEBUT=IBAC-1
      IF(EVAL.EQ.0) RETURN
   90 IF(PILE(DEBUT).GT.0) GO TO 110
      DEBUT=DEBUT-1
      GO TO 90
C IDEBUT := 1-SZY EL.WOLAJACEJ 4-KI
C 4-KI POPRZEDNIKOW MIEDZY NAMI A ZNALEZIONYM ZNAKUJEMY ZMIENIAJAC
C  ZNAK ADRESU LITERALU
  110 DEBUT=DEBUT-3
      PILE((DEBUT+1))=(-PILE( DEBUT+1))
      IDEBUT=DEBUT
  120 IF (PILE( DEBUT).EQ.I) GO TO 130
      DEBUT=PILE( DEBUT)
      PILE(DEBUT)=-PILE( DEBUT)
      DEBUT=DEBUT-1
      GO TO 120
C KOMPAKTYFIKACJA.PRZECHOWUJEMY TYLKO OZNAKOWANZ LANCUCH POPRZEDNIKOW,
C ZERUJAC LISTY WYBORU I PRZYWRACAJAC ADRESY LITERALOW,ORAZ INFORMACJE
C O PODSTAWIENIACH NIE-LOKALNYCH PO KAZDYM POPRZEDNIKU.
C KOPIOWANIE: DEBUT DO J.
  130 DEBUT = I-1
      J=DEBUT
      IANC=PILE( DEBUT)
      K=PILE( DEBUT+3)
  142 CONTINUE
      PILE((J+2))=0
      PILE((J+3))=PILE( DEBUT+3)
      IANC=J+1
      J=J+4
  144 DEBUT=DEBUT+4
  150 IF(PILE( DEBUT).GE.0) GO TO 170
C INFORMACJA O PODSTAWIENIACH
      IF(-PILE( DEBUT).LT.K) GO TO 160
      PILE(J)=PILE( DEBUT)
      J=J+1
  160 DEBUT=DEBUT+1
      GO TO 150
C* CAS D'UN ANCETRE....................................................*
C 4-KA . NIEOZNAKOWANA OPUSZCZAMY,DLA OZNAKOWANEJ USTAWIAMY K
  170 IF (PILE( DEBUT+1).GE.0) GO TO 144
      IF (DEBUT.EQ.IDEBUT) GO TO 190
      K=PILE( DEBUT+3)
      PILE(J)=IANC
      PILE(J+1)= -PILE(DEBUT+1)
      GO TO 142
C WROCILISMY DO 4-KI WOLAJACEJ.PRZYWRACAMY ADRES LITERALU,ZERUJEMY
C LISTE WYBORU I KOPIUJEMY ADRES STREFY ZMIENNYCH WRAZ Z INFORMACJA
C O PODSTAWIENIACH NA ZMIENNE ZUNIFIKOWANEGO POPRZEDNIKA
  190 PILE(J)=IANC
      PILE((J+1))=-PILE( DEBUT+1)
      PILE((J+2))=0
      J=J+3
      RETOUR=J-2
      MI=DEBUT+3
        MJ=IBAC-1
      DO 200 K=MI,MJ
      PILE(J)=PILE( K)
  200 J=J+1
      IBAC=J
      RETURN
      END
      SUBROUTINE UNIV
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER TABMIN,PILMIN
      INTEGER DTAB,DPILE,ITER,IVAR,IBAC,IREC
      INTEGER CLES(800),CALCUL(256)
      INTEGER POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      INTEGER MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,AXNIL,
     * AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      INTEGER AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,MESS,
     * TRACRH
      INTEGER TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      INTEGER KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,ARG,
     * DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     *  COMPTE,LIMITE
      COMMON  TAB  /MSTACK/ PILE

      COMMON/MINMIN/ PILMIN,TABMIN
      COMMON /RUNSYS/ DTAB,DPILE,ITER,IVAR,IBAC,IREC
      COMMON /AUXTAB/ CLES,CALCUL
      COMMON/DATSTR/ POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      COMMON /CONST/ MARGE,NBRE,LETTRE,CHIFFR,CARACT,
     * CNIL,CPOINT,AXNIL,AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      COMMON /SYSWIT/ AJB,AJC,UNAT,LUB,NETTO,TT,BOOL,CLOCON,OLDCLO,CR,
     * MESS,TRACRH
      COMMON /COMMUN/ TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      COMMON /AUXVAR/ KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,
     * ARG,DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     * COMPTE,LIMITE
      CLAUSR=TERM+1
      INSTR=INST
      TERM=CLAUSR
      CALL DESC
      KFTT=TAB(TERM)
      IF(KFTT.LT.0.AND.KFTT.GT.NBRE) GO TO 110
C***********************************************************************
C* LE PREMIER ARGUMENT EST UN ARBRE OU UN NOMBRE.......................*
C***********************************************************************
C UTWORZONA ZOSTANIE STREFA PODSTAWIEN DLA .(*X,*Y) ODPOWIADAJACA POSTAC
C  ROZLOZONEJ PIERWSZEGO ARGUMENTU UNIV.
      J=CLAUSR
      IPOINT=IVAR
      IF(IVAR-ITER.LE.MARGE) CALL MESSAGE(1)
      IVAR=IVAR-4
      INSTA=IPOINT+2
      IF(KFTT.GT.0) GO TO 20
C***********************************************************************
C* CAS D'UN NOMBRE.....................................................*
C***********************************************************************
C LICZBA (REPREZENTOWANA JAKO NBRE-LICZBA) ZAMIENIANA JEST NA GRZEBIEN C
C JAKO NAZWE PREDZKATU BEZ ARGUMENTOW
C STREFA ZACZYNA SIE OD :
C   -ARG1 ZEWNETRZNEJ  KROPKI,TJ. KROPKA Z PODSTAWIENIEM OKRESLAJACYM DA
C             CZESC TWORZONEJ STREFY JAKO JEJ STREFE ZMIENNYCH
C   - ARG2 ZEWNETRZNEJ KROPKI,TJ. NIL
      TAB(IPOINT)=AXPOIN
      TAB(IPOINT-1)=IVAR+2
      TAB(IPOINT-2)=AXNIL
      TAB(IPOINT-3)=0
      M= -KFTT+NBRE
      IF (M.NE.0) GO TO 7
      K=1
      L=0
      GO TO 12
C DZIELENIE PRZEZ CORAZ NIZSZE POTEGI 10 I WYCHWYTYWANIE RESZTY JAKO KOL
C    CYFRY. ENTIER PRZESTAJE BYC ZEREM PO ZLAPANIU PIERWSZEJ CYFRY
    7 K=1000000
    8 L=M/K
      IF(L.EQ.0.AND.ENTIER.EQ.0) GO TO 19
   12 TAB(IVAR)=LETTRE+6*(L+1)
      TAB(IVAR-1)=0
      ENTIER=1
      IF(K .EQ. 1)GO TO 16
      TAB(IVAR-2)=AXPOIN
      TAB(IVAR-3)=IVAR-2
      IVAR=IVAR-4
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
   19 M=MOD(M,K)
      K=K/10
      GO TO 8
   16 TAB(IVAR-2)=AXNIL
      TAB(IVAR-3) =0
      IVAR=IVAR-4
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
      ENTIER=0
      GO TO 70
C***********************************************************************
C*  CAS D'UN ARBRE.....................................................*
C***********************************************************************
C STREFA ZACZYNA SIE OD :
C   - ARG1 ZEWNETRZNEJ KROPKI,TJ.ODSYLACZA DO GRZEBIENIA BEDACEGO NAZWA
C   - ARG2 ZEWNETRZNEJ KROPKI,TJ.NIL LUB PIERWSZEJ KROPKI GRZEBIENIA ARG
C "PODSTAWIENIA" KROPEK GRZEBIENIA WSKAZUJA NA PARY SWOICH KROPEK,WSKAZU
C  N SPOSOB BEZPOSREDNIO NASTEPUJACE ELEMENTY TWORZONEJ STREFY JAKO ICH
C ZMIENNYCH
   20 IF(KFTT.GT.CHIFFR+2) GO TO 21
C TERM JEST ZNAKIEM
      TAB(IPOINT)=KFTT-3
      GO TO 23
   21 TAB(IPOINT) = TAB(KFTT+NOM)
   23 TAB(IPOINT-1) = 0
      ARG = TAB(KFTT+POIDS)
   22 IF(ARG.EQ.0) GO TO 40
      TAB(IPOINT-2) = AXPOIN
      TAB(IPOINT-3)=IVAR+2
      IPOINT=IVAR
      IF(IVAR-ITER.LE.MARGE) CALL MESSAGE(1)
      IVAR=IVAR-4
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
      TAB(IPOINT)=TERM+1
      TAB(IPOINT-1)=INST
      RESTER=TERM+1
      CALL SAUT
      TERM=RESTER-1
      KFTT=TAB(TERM)
      ARG=ARG-1
      GO TO 22
   40 TAB(IPOINT-2) =AXNIL
      TAB(IPOINT-3)=0
C***********************************************************************
C*  UNIFICATION DES DEUX ARBRES PEIGNES................................*
C***********************************************************************
C  CLAUSR -> DRUGI ARGUMENT UNIV
C  INSTR -> STREFA ZMIENNYCH TEGO WOLANIA UNIV
C  CLAUSA ->  .(*X,*Y)
C   INSTA -> UTWORZONA WLASNIE STREFA
   70 IF(TAB(J).GE.0) GO TO 90
      CLAUSR=J+1
      GO TO 100
90    RESTER=J
      CALL SAUT
      CLAUSR=RESTER
  100 CLAUSA=AXPOIN
      CALL UNIFIE
      RETURN
C***********************************************************************
C* LE PREMIER ARGUMENT EST UNE VARIABLE................................*
C* VERIFICATION DE LA STRUCTURE DROITE .CALCUL DU NOMBRE D'ARGUMENTS...*
C* ET CREATION DE LA SUBSTITUTION SUBSAX POUR AXTER....................*
C***********************************************************************
C SPRAWDZENIE,CZY DRUGI ARGUMENT UNIV JEST GRZEBIENIEM
C UTWORZENIE STREFY PAR :
C (*X W  .(*X,*Y) ^ STREFA ZMIENNYCH TEGO WCIELENIA  .(*X,*Y) )
C DLA KAZDEJ KROPKI GRZEBIENIA ARGUMENTOW. JEST TO STREFA ARGUMENTOW TER
C  ROZLOZONEGO BEDACEGO 2GIM ARGUMENTEM UNIV.  ARG ZLICZA ARGUMENTY
  110 CLAUSR=CLAUSR+1
      J=TERM
      INSTA=INST
      ARG=0
      TERM=CLAUSR
      INST=INSTR
      CALL DESC
      KFTT=TAB(TERM)
      TERM1=TERM
      INST1=INST
      SUBSAX=IVAR+2
      IF(KFTT.EQ.CPOINT) GO TO 130
C NIE JEST TO GRZEBIEN. WYMAZANIE STREFY I BLAD
  120 T=2
      MI=SUBSAX-2
      DO 122 I=IVAR,MI
  122 TAB(I)=0
      IVAR=SUBSAX-2
      RETURN
130   RESTER=TERM+1
      CALL SAUT
      TERM=RESTER
      CALL DESC
      KFTT=TAB(TERM)
       IF(KFTT.EQ.CNIL) GO TO 158
      IF(KFTT.NE.CPOINT) GO TO 120
  150 ARG=ARG+1
      IF(IVAR-ITER.LE.MARGE) CALL MESSAGE(1)
      TAB(IVAR)=TERM+1
      TAB(IVAR-1)=INST
      IVAR=IVAR-2
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
      GO TO 130
C***********************************************************************
C* LE NOMBRE D'ARGUMENTS EST ARG.......................................*
C* TRAITEMENT DE LA PARTIE GAUCHE......................................*
C***********************************************************************
C SPRAWDZENIE,CZY PIERWSZY ARGUMENT ZEWNETRZNEJ KROPKI DRUGIEGO ARGUMENT
C  UNIV JEST GRZEBIENIEM NAZWY TERMU.  NAZWE WPISUJE SIE OD RAZU DO SLOW
158   TERM=TERM1
      INST=INST1
      DEBUT=ITER
      TERM=TERM+1
      CALL DESC
      KFTT=TAB(TERM)
      IF(KFTT.NE.CPOINT) GO TO 120
  160 CONTINUE
      INST1=INST
      TERM1=TERM+2
      TERM=TERM+1
      CALL DESC
      KFTT=TAB(TERM)
      IF(KFTT.LT.2.OR.KFTT.GT.CHIFFR+2) GO TO 230
      IF(KFTT.GT.LETTRE+2) GO TO 180
C ENTIER=1 JESLI NAZWA ZAWIERALA LITERE (WIEC NIE JEST TO LICZBA)
      ENTIER=1
  180 IF(IVAR-ITER.LE.MARGE) CALL MESSAGE(1)
      TAB(ITER)=CPOINT
      TAB(ITER+1)=TAB(TERM)
      ITER=ITER+2
      IF(IVAR-ITER.LT.TABMIN)TABMIN=IVAR-ITER
      TERM=TERM1
      KFTT=TAB(TERM)
      INST=INST1
      IF(KFTT.GE.0) GO TO 200
      CALL DESC
      KFTT=TAB(TERM)
  200 IF(KFTT.NE.CPOINT) GO TO 220
C UNLETT=1 JESLI NAZWA MA WIECEJ NIZ JEDEN ZNAK
      UNLETT=1
      GO TO 160
  220 IF(KFTT.EQ.CNIL) GO TO 240
C NIE JEST TO GRZEBIEN ZNAKOW.WYMAZAC ZE SLOWNIKA I BLAD
230   DO 232 I=DEBUT,ITER
232   TAB(I)=0
      ITER=DEBUT
      GO TO 120
240   TAB(ITER)=CNIL
      ITER=ITER+1
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
C***********************************************************************
C* LA STRUCTURE DE L'UNITE EST VERIFIEE ET ECRITE EN POINTS............*
C* CODAGE DE L'UNITE DANS LE DICO ET CONSTRUCTION D'AXTER..............*
C***********************************************************************
C HASHOWANIE
      NOM1 = 0
      LOCAL=DEBUT+1
      KEY=TAB(LOCAL)
      IF(TAB(LOCAL+1).EQ.CNIL) GO TO 241
      KEY=KEY+TAB(LOCAL+2)/2
      IF(TAB(LOCAL+3).EQ.CNIL) GO TO 241
      KEY=MOD(KEY+TAB(LOCAL+4),800)+1
      IF(TAB(LOCAL+5).EQ.CNIL) GO TO 241
      KEY=MOD(KEY+TAB(LOCAL+6)*2,800)+1
C DO 410 - JEDEN ZNAK BEZ ARGUMENTOW
C DO 350 - LICZBA
C DO 243  WIELE ZNAKOW LUB BEZ ARGUMENTOW
  241 IF(UNLETT.EQ.0.AND.ARG.EQ.0) GO TO 410
      IF (ENTIER.EQ.0.AND.ARG.EQ.0) GO TO 350
      IF (UNLETT.NE.0.OR.ARG.EQ.0) GO TO 243
C TU JESLI JEDEN ZNAK Z ARGUMENTAMI
      NOM1=KEY-3
      DO 242 I=DEBUT,ITER
  242 TAB(I)=0
      ITER=DEBUT
C***********************************************************************
C* CAS D'UNE UNITE COURANTE............................................*
C***********************************************************************
  243 UNLETT=0
      ENTIER=0
      ICLES=CLES(KEY)
      IF(ICLES.NE.0) GO TO 250
C LANCUCH PUSTY
      IF(UNAT .EQ. 0 ) GO TO 245
      T=1
      GO TO 430
245   CONTINUE
      CLES(KEY)=ITER
      ICLES=ITER
      GO TO 290
C***********************************************************************
C* RECHERCHE DANS LE DICTIONNAIRE......................................*
C***********************************************************************
C LANCUCH NIE PUSTY,WIEC MOZE TERM JUZ ZNANY
  250 CLAUSR=TAB(ICLES+NOM)
      CLAUSA=DEBUT
      IF(NOM1.NE.0) CLAUSA=NOM1
      CALL UNIFIE
      IF(T.EQ.1) GO TO 270
C NAZWA JEST JUZ W SLOWNIKU,WIEC NIE BEDZIE POTRZEBNA JEJ NOWA REPREZENT
      DO 261 I=DEBUT,ITER
  261 TAB(I)=0
      ITER=DEBUT
      IF(TAB(ICLES+POIDS).EQ.ARG) GO TO 400
      NOM1=TAB(ICLES+NOM)
  270 T=0
      KF=TAB(ICLES+NEXT)
      IF(KF.EQ.0) GO TO 282
      ICLES=KF
      GO TO 250
C***********************************************************************
C* CODAGE DE L'UNITE DANS LE DICTIONNAIRE .............................*
C***********************************************************************
C NIE BYLO TEJ NAZWY Z TAKA ARGUMENTOWOSCIA. TRZEBA ZAKODOWAC TERM LUB
C ZAWIESC,JESLI TO ATOME (UNAT=1)
  282 IF(UNAT.EQ.0) GO TO 284
      T=1
      GO TO 430
  284 TAB(ICLES+NEXT)=ITER
  290 IF(NOM1.NE.0) GO TO 310
      TAB(ITER+NOM)=DEBUT
      GO TO 320
  310 TAB(ITER+NOM)=NOM1
  320 IF(IVAR-ITER.LE.MARGE) CALL MESSAGE(1)
      TAB(ITER+POIDS)=ARG
      TAB(ITER+PRED) =0
      TAB(ITER+AXTER)=ITER+5
      TAB(ITER+NEXT) = 0
C "UCHWYT" TERMU
      TAB(ITER+5)=ITER
      ICLES=ITER
      ITER=ITER+6
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER

      IF(ARG.EQ.0) GO TO 400
C ARGUMENTY - KOLEJNE LICZBY UJEMNE
      DO 330 I=1,ARG,1
      IF(IVAR-ITER.LE.MARGE) CALL MESSAGE(1)
      TAB(ITER)=-I
  330 ITER=ITER+1
      IF(IVAR-ITER.LT.TABMIN) TABMIN=IVAR-ITER
C***********************************************************************
C* SUBSAX EXISTE ET L'UNITE EST CODEE^ ICLES EST POSITIONNE............*
C***********************************************************************
      GO TO 400
C***********************************************************************
C* CAS D'UN ENTIER.....................................................*
C***********************************************************************
C UTWORZENIE LICZBY Z CYFR W GRZEBIENIU NAZWY
  350 UNLETT=0
      I=0
      II=1
      IDEB=ITER-2
      ILET=LETTRE+8
  360 ENTIER=ENTIER+((TAB(IDEB-I-I)-ILET)/6)*II
      IF(IDEB-I-I-1.EQ.DEBUT) GO TO 380
      I=I+1
      II=II*10
      GO TO 360
C***********************************************************************
C* SUBSTITUTION DE LA VARIABLE DE UNIV.................................*
C***********************************************************************
C LICZBA REPREZENTOWANA JEST JAKO PARA :
C (TERM -> PODSTAWIENIE ^ PODSTAWIENIE = NBRE-LICZBA)
380   LOCAL=INSTA+2*TAB(J)
      TAB(LOCAL)= LOCAL-1
      TAB(LOCAL-1)=NBRE-ENTIER
      IF(LOCAL.GE.LIMITE) CALL SUBST
      GO TO 430
400   LOCAL=INSTA+2*TAB(J)
      TAB(LOCAL)=TAB(ICLES+AXTER)
      TAB(LOCAL-1)=SUBSAX
      IF(LOCAL.GE.LIMITE) CALL SUBST
      RETURN
C TERM JEST ZNAKIEM
410   LOCAL=INSTA+2*TAB(J)
      TAB(LOCAL)=KEY-2
      TAB(LOCAL-1)=SUBSAX
      IF(LOCAL.GE.LIMITE) CALL SUBST
C WYMAZANIE ZE SLOWNIKA SWIEZEJ NAZWY UTWORZONEJ PODCZAS PRZEGLADANIA
C  GRZEBIENIA.
  430 MI=ITER-1
      DO 440 I=DEBUT,MI
  440 TAB(I)=0
      ENTIER=0
      ITER=DEBUT
      RETURN
      END
      SUBROUTINE INF
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,AXNIL,
     * AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      INTEGER TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      INTEGER KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,ARG,
     * DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     *  COMPTE,LIMITE
      COMMON  TAB  /MSTACK/ PILE
      COMMON /CONST/ MARGE,NBRE,LETTRE,CHIFFR,CARACT,
     * CNIL,CPOINT,AXNIL,AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      COMMON /COMMUN/ TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      COMMON /AUXVAR/ KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,
     * ARG,DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     * COMPTE,LIMITE
      CLAUSR=TERM
      INSTR=INST
      TERM=CLAUSR+1
      INST=INSTR
      CALL DESC
      KF=TAB(TERM)
      SEPAR=KF-NBRE
      IF(SEPAR.LE.0.OR.(KF.GT.0.AND.KF.LE.CHIFFR+2)) GO TO 20
   10 T=2
      RETURN
   20 EXPLOR=SEPAR
      TERM=CLAUSR+2
      INST=INSTR
      CALL DESC
      KF=TAB(TERM)
      SEPAR=KF-NBRE
      IF(SEPAR.GT.0.AND.(KF.LE.0.OR.KF.GT.CHIFFR+2)) GO TO 10
30    IF (EXPLOR.GT.0.AND.SEPAR.GT.0) GO TO 40
      IF(EXPLOR.LE.SEPAR) T=1
      RETURN
40    IF (EXPLOR.GE.SEPAR) T=1
      RETURN
      END
      SUBROUTINE ANCETR
      INTEGER PILMIN,TABMIN
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER DTAB,DPILE,ITER,IVAR,IBAC,IREC
      INTEGER MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,AXNIL,
     * AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      INTEGER TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      INTEGER KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,ARG,
     * DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     *  COMPTE,LIMITE
      COMMON/MINMIN/PILMIN,TABMIN
      COMMON  TAB  /MSTACK/ PILE
      COMMON /RUNSYS/ DTAB,DPILE,ITER,IVAR,IBAC,IREC
      COMMON /CONST/ MARGE,NBRE,LETTRE,CHIFFR,CARACT,
     * CNIL,CPOINT,AXNIL,AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      COMMON /COMMUN/ TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      COMMON /AUXVAR/ KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,
     * ARG,DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     * COMPTE,LIMITE
      K=TERM+1
      L=INST
      TERM=K
      CALL DESC
      IF(TAB(TERM).EQ.PLUS.OR.TAB(TERM).EQ.MOINS) GO TO 10
      T=2
      RETURN
C***********************************************************************
C* RECHERCHE DE L'ANCETRE..............................................*
C***********************************************************************
   10 I=PILE( IBAC-4)
   12 CONTINUE
      IF(I.NE.0) GO TO 30
      T=1
      RETURN
   30 CLAUSA=PILE( I)+1
      INSTA=PILE( PILE( I-1)+2)
      CLAUSR=K
      INSTR=L
      LIMITE=IVAR
   32 CALL UNIFIE
      IF(T.EQ.0) RETURN
C***********************************************************************
C* REMISE A ZERO DES SUBSTITUTIONS ....................................*
C***********************************************************************
   40 IBAC=IBAC-1
      T=0
      KF=PILE(IBAC)
      IF(KF.GE.0) GO TO 60
      TAB(-KF) =0
      TAB(-KF-1) =0
      GO TO 40
   60 IBAC=IBAC+1
      IF(IREC-IBAC.LT.PILMIN) PILMIN=IREC-IBAC
      I=PILE( I-1)
      GO TO 12
      END
      SUBROUTINE TRLINE
C PRINT A LINE OF TRACE INFO
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      INTEGER LECMAX,IMPMAX,IENTRE,IENTR2,ISORTI,ISORT2,W
      INTEGER LIMIT,LAST,LBUF(113)
      COMMON  TAB  /MSTACK/ PILE
      COMMON /DATSTR/ POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      COMMON /IOCV/ LECMAX,IMPMAX,IENTRE,IENTR2,ISORTI,ISORT2,W
      COMMON /IOTR/ LIMIT,LAST,LBUF
      COMMON /SCHIND/ KBLANK,ILPAR,IRPAR,ISTAR,IQMARK,ICOMMA,ISLASH
      COMMON /TRNUM/ NTR,LLAST
      IF(LAST.GE.LIMIT) GO TO 2
      LAST = LAST + 1
      DO 1 K=LAST,LIMIT
    1 LBUF(K) = KBLANK
    2 CONTINUE
      GO TO (11,12,13,14),NTR
   11 WRITE(W,91)
      GO TO 50
   12 WRITE(W,92)
      GO TO 50
   13 WRITE(W,93)
      GO TO 50
   14 WRITE(W,94)
   50 WRITE(W,90)(TAB(LBUF(K)+CODE),K=1,LIMIT)
      LAST=0
      RETURN
   90 FORMAT(1H+,10X,110A1)
   91 FORMAT(11H TRACERES: ,110X)
   92 FORMAT(11H TRACEIMP: ,110X)
   93 FORMAT(11H IMPRANC : ,110X)
   94 FORMAT(11H IMPRRES : ,110X)
      END
      SUBROUTINE TROUT(ICHART)
C ADD A CHARACTER TERM POINTER TO TRACE INFO LINE
      INTEGER LIMIT,LAST,LBUF(113)
      COMMON /IOTR/ LIMIT,LAST,LBUF
      IF(LAST.EQ.LIMIT) CALL TRLINE
      LAST = LAST+1
      LBUF(LAST) = ICHART
      RETURN
      END
      SUBROUTINE TRNAME(INAME)
C NAME OF A TERM TO TRACE LINE
C INAME - INDEX OF ID REPRESENTATION
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,AXNIL,
     * AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      INTEGER POIDS,PRED,NOM
      COMMON /DATSTR/ POIDS,PRED,NOM
      COMMON  TAB  /MSTACK/ PILE
      COMMON /CONST/ MARGE,NBRE,LETTRE,CHIFFR,CARACT,
     * CNIL,CPOINT,AXNIL,AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      ICH=CHIFFR+2
      N=INAME
      IF(N.LE.ICH) GO TO 1
      N=TAB(INAME+NOM)
      IF(N.GT.ICH) GO TO 2
    1 CONTINUE
      CALL TROUT((N/6)*6 +4)
      RETURN
    2 IF(TAB(N).EQ.CNIL) RETURN
      CALL TROUT(TAB(N+1))
          N=N+2
          GO TO 2
          END
      SUBROUTINE TRNUMB(NUMB)
C CONVERT A NUMBER TO TRACE LINE FORMAT
      INTEGER LETTRE
      COMMON /CONST/ NIC(2),LETTRE
          K = 1000000
          N=NUMB
          IZERO= LETTRE+8
    1 M=N/K
      N=N-M*K
          K=K/10
      IF(M.NE.0) GO TO 2
          IF(K.NE.0) GO TO 1
      CALL TROUT(IZERO)
          RETURN
    2 CALL TROUT(IZERO+M*6)
          IF(K.EQ.0) RETURN
      M=N/K
      N= N- M*K
          K=K/10
          GO TO 2
          END
      SUBROUTINE TRTERM
C TROUT A TERM,FORCING TRLINE IF LAST.NE.0
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      INTEGER MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,AXNIL,
     * AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      INTEGER ENTRE(80),ENTRE2(80),SORTIE(120),SORTI2(120)
      INTEGER LECMAX,IMPMAX,IENTRE,IENTR2,ISORTI,ISORT2,W
      INTEGER TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      INTEGER STSIZE,TOP,S(99)
      INTEGER LIMIT,LAST,LBUF(113)
      INTEGER RESTER
      INTEGER DTAB
      COMMON /RUNSYS/ DTAB
      COMMON/AUXVAR/ NIC(19),RESTER
      COMMON  TAB  /MSTACK/ PILE
      COMMON /DATSTR/ POIDS,PRED,NOM,AXTER,NEXT,ACPL,ACMO,CLO,SUIV,CODE
      COMMON /CONST/ MARGE,NBRE,LETTRE,CHIFFR,CARACT,
     * CNIL,CPOINT,AXNIL,AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      COMMON /COMMUN/ TERM,INST,U,T,EVAL,CLAUSA,CLAUSR,INSTA,INSTR
      COMMON /TSTACK/ STSIZE,TOP,S
      COMMON /SCHIND/ KBLANK,ILPAR,IRPAR,ISTAR,IQMARK,ICOMMA,ISLASH
      COMMON /TRNUM/ NTR,LLAST
      TOP = 0
C
C TROJKI NA STOSIE (TYLKO DLA TERMOW Z ARGUMENTAMI) :
C     PRZETWARZANY ARGUMENT (SMIECI PO OSTATNIM)
C     INST
C     ILOSC POZOSTALYCH ARGUMENTOW
C
   10 CALL DESC
      KT=TAB(TERM)
C NUMBER?
          IF(KT.GT.NBRE) GO TO 20
      CALL TRNUMB(NBRE-KT)
          GO TO 52
C VARIABLE?
   20 IF(KT.GE.0) GO TO 30
      CALL TROUT(KBLANK)
      CALL TROUT(ISTAR)
      CALL TRNUMB(-KT)
      CALL TROUT(ISLASH)
      CALL TRNUMB(DTAB-INST)
      CALL TROUT(KBLANK)
          GO TO 52
C A TERM !
C PRINT NAME AND LEFT PARENTHESIS IF ANY ARGUMENTS
   30 CALL TRNAME(KT)
          NARG=TAB(KT+POIDS)
          IF(NARG.EQ.0) GO TO 52
      CALL TROUT(ILPAR)
C SAVE STATUS BEFORE RECURSION
          TOP=TOP+3
          IF(TOP.LE.STSIZE) GO TO 35
C OVERFLOW
      CALL TROUT(ISTAR)
      CALL TROUT(ISTAR)
      CALL TROUT(IQMARK)
      CALL TROUT(ISTAR)
      CALL TROUT(ISTAR)
          GO TO 50
C OK
   35 S(TOP-2) = TERM+1
          S(TOP-1)=INST
          S(TOP)=NARG
          GO TO 42
C IF ANY ARGS LEFT,RECURSION INTO THE NEXT ONE
   40 IF(S(TOP).EQ.0) GO TO 50
      CALL TROUT(ICOMMA)
      RESTER=S(TOP-2)
      CALL SAUT
      S(TOP-2) = RESTER
C
   42 S(TOP)=S(TOP)-1
      TERM=S(TOP-2)
      INST = S(TOP-1)
      GO TO 10
C END OF ARGUMENT LIST
   50 CALL TROUT(IRPAR)
          TOP=TOP-3
   52 IF(TOP.NE.0) GO TO 40
C PRINT LAST LINE OF TRACE
      IF(LLAST.NE.0) CALL TRLINE
      RETURN
      END
      SUBROUTINE IMPRAN
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,AXNIL,
     * AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      INTEGER TERM,INST
      INTEGER DTAB,DPILE,ITER,IVAR,IBAC,IREC
      COMMON /RUNSYS/ DTAB,DPILE,ITER,IVAR,IBAC,IREC
      COMMON /COMMUN/ TERM,INST
      COMMON TAB /MSTACK/ PILE
      COMMON /CONST/ MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,
     * AXNIL,AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      COMMON /TRNUM/ NTR,LLAST
      TERM=TERM+1
      CALL DESC
      ILE=TAB(TERM)
      IF(ILE.GT.NBRE) GO TO 1
      ILE=NBRE-ILE
      GO TO 9
    1 IF(ILE.GT.LETTRE+2.AND.ILE.LE.CHIFFR+2) GO TO 2
      T=2
      RETURN
    2 ILE=(ILE-LETTRE-8)/6
    9 KTHIS=IBAC-3
   10 IF(ILE.LE.0) RETURN
      KTHIS= PILE(KTHIS-1)
      IF(PILE(KTHIS-1).EQ.0) RETURN
      TERM=PILE(KTHIS)+1
      INST=PILE(PILE(KTHIS-1)+2)
      CALL DESC
      NTR=3
      LLAST=1
      CALL TRTERM
      ILE = ILE-1
      GO TO 10
      END
      SUBROUTINE IMPRES
      INTEGER TAB(&TAB),PILE(&PILE)
      INTEGER MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,AXNIL,AXPOIN,
     * PLUS,MOINS,BOULOT,ERREUR,NIL
      INTEGER KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,INPL,INMO,ARG,
     * DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,CFINAX,RETOUR,RESTER,
     * COMPTE,LIMITE
      INTEGER TERM,INST
      INTEGER DTAB,DPILE,ITER,IVAR,IBAC,IREC
      COMMON /RUNSYS/ DTAB,DPILE,ITER,IVAR,IBAC,IREC
      COMMON /COMMUN/ TERM,INST
      COMMON TAB /MSTACK/ PILE
      COMMON /CONST/ MARGE,NBRE,LETTRE,CHIFFR,CARACT,CNIL,CPOINT,
     * AXNIL,AXPOIN,PLUS,MOINS,BOULOT,ERREUR,NIL
      COMMON /AUXVAR/ KEY,UNLETT,ENTIER,TERM1,INST1,SUB,LOCAL,
     * INPL,INMO,ARG,DEBUT,EXPLOR,ISTOR,SEPAR,NOP,BAS,SUBSAX,
     * CFINAX,RETOUR,RESTER,COMPTE,LIMITE
      COMMON /TRNUM/ NTR,LLAST
      COMMON /SCHIND/ KBLANK
      NTR=4
      LLAST=0
      KEEPR = RESTER
      KTHIS=IBAC-3

       GO TO 100
   10 KTHIS = PILE(KTHIS-1)

  100 CONTINUE
      IF(PILE(KTHIS-1).EQ.0) GO TO 99
      RESTER = PILE(KTHIS) +1
   11 CONTINUE
      CALL SAUT
      IF(TAB(RESTER).EQ.CNIL) GO TO 10
       IF(TAB(RESTER).EQ.CPOINT) GO TO 12
      WRITE(6,999)
      STOP ??
  999 FORMAT(25H1BAD TERM FOUND BY IMPRES)
   12 TERM=RESTER+1
      INST=PILE(PILE(KTHIS-1)+2)
      CALL DESC
      CALL TROUT(KBLANK)
      CALL TROUT(KBLANK)
      CALL TRTERM
      RESTER = RESTER+1
      GO TO 11
   99 CALL TRLINE
      RESTER=KEEPR
      RETURN
      END
      FINISH
« March 2024 »
Su Mo Tu We Th Fr Sa
1 2
3 4 5 6 7 8 9
10 11 12 13 14 15 16
17 18 19 20 21 22 23
24 25 26 27 28 29 30
31
 

Powered by Plone CMS, the Open Source Content Management System

This site conforms to the following standards: