odra.3 prolsource
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