C
C This file is issued from the MODULEF library, but has been 
C subsequently modified
C
      SUBROUTINE FONCOR(M,MEXP,MOPN,MOPT,MSYM,ICODE)
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C           S.P. FONCOR          (FONCTIONS INTERPRETEES)
C           -----------
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C BUT :
C   ANALYSER LE CORPS D UNE FONCTION
C   LE CORPS EST FORME D UNE EXPRESSION INFIXEE, QUI EST MISE ICI
C   SOUS FORME POLONAISE INVERSE
C   L'ALGORITHME EST INSPIRE DE 'CONCEPTS OF PROGRAMMING LANGUAGES',
C   DE MARK ELSON, APPENDIX 1
C
C PARAMETRES D ENTREE :
C     M       : SUPER-TABLEAU
C     MEXP    : PILE DES EXPRESSIONS
C     MOPN    : PILE DES OPERANDES
C     MOPT    : PILE DES OPERATEURS
C     MSYM    : TABLE DES SYMBOLES
C
C PARAMETRES DE SORTIE :
C     ICODE   : CODE DE RETOUR (VOIR LE S.P. FONERR)
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C PROGRAMMEUR : PATRICK LAUG ; INRIA (3) 954 90 20 POSTE 508
C ......................................................................
      INTEGER M(*),MEXP(*),MOPN(*),MOPT(*),MSYM(*),MTYPE(5)
      CHARACTER*256 CITEM
      COMMON /FONIA / IAI,IAR,IAL,IAC,IAD,IAOPN,IAOPT,IASYM,IAEXP,IAIDN
      COMMON /FONLC / LCI,LCR,LCL,LCC,LCD,LCOPN,LCOPT,LCSYM,LCEXP,LCIDN
      COMMON /FONLM / LMI,LMR,LML,LMC,LMD,LMOPN,LMOPT,LMSYM,LMEXP,LMIDN
      DATA MTYPE /4,1,2,2,5/
C
C ON MET UNE PARENTHESE OUVRANTE EN BAS DE LA PILE DES OPERATEURS
C COMME SA PRIORITE EST MINIMALE, LES OPERATEURS SUIVANTS SERONT EMPILES
      LCOPT   = 1
      MOPT(1) = 40 002
      LCOPNI  = LCOPN
C      LCEXPI  = LCEXP      OPTIM
C
C LECTURE DE L'ITEM SUIVANT
  100 CALL FONSUI(CITEM,LITEM,NITEM)
C
C L'ITEM EST UN IDENTIFICATEUR
C AJOUTER L'IDENTIFICATEUR DANS LA QUEUE
      IF (NITEM .EQ. 10 000) THEN
         CALL FONCID(CITEM(1:LITEM), I, ICODE)
C ------ CAS PARTICULIER : VARIABLE GLOBALE (CF F. HECHT)
         IF (ICODE.NE.0) THEN
            CALL FONVAR(CITEM(1:LITEM), M(IAR), MEXP, MOPN, ICODE)
            IF (ICODE.NE.0) RETURN
            GOTO 100
         END IF
         IF (MSYM(I) / 10 000 .NE. 2) THEN
            ICODE = 5
            RETURN
         END IF
         CALL FONAIT(MEXP(MSYM(I)-20 000), MEXP, MOPN, ICODE)
         IF (ICODE.NE.0) RETURN
         GOTO 100
C
C L'ITEM EST UNE CONSTANTE
C AJOUTER LA CONSTANTE DANS LA QUEUE
      ELSE IF (NITEM / 10 000 .EQ. 3) THEN
         NTYPE = MTYPE(NITEM/1000 - 30)
         CALL FONACS(CITEM(1:LITEM),NTYPE,
     +      M(IAI),M(IAR),M(IAL),M(IAC),M(IAD),IALLOC,ICODE)
         IF (ICODE.NE.0) RETURN
         CALL FONAIT(30 000 + NTYPE*1000 + IALLOC,MEXP,MOPN,ICODE)
         IF (ICODE.NE.0) RETURN
         GOTO 100
C
C L'ITEM EST UNE VIRGULE
C DEVERSER LA PILE DANS LA QUEUE JUSQU'A RENCONTRER UNE PAR. OUV.
      ELSE IF (NITEM.EQ.40 004) THEN
  200    IF (LCOPT .LE. 1) THEN
            ICODE = 7
            RETURN
         END IF
         IF (MOPT(LCOPT) .EQ. 40 002) GOTO 100
         CALL FONAIT(MOPT(LCOPT),MEXP,MOPN,ICODE)
         IF (ICODE.NE.0) RETURN
         LCOPT = LCOPT - 1
         GOTO 200
C
C L'ITEM EST UNE PARENTHESE FERMANTE
C DEVERSER LA PILE DANS LA QUEUE JUSQU'A RENCONTRER UNE PAR. OUV.
      ELSE IF (NITEM.EQ.40 003) THEN
  240    IF (LCOPT .LE. 1) THEN
            ICODE = 7
            RETURN
         END IF
         IF (MOPT(LCOPT) .EQ. 40 002) THEN
            LCOPT = LCOPT - 1
            GOTO 100
         END IF
         CALL FONAIT(MOPT(LCOPT),MEXP,MOPN,ICODE)
         IF (ICODE.NE.0) RETURN
         LCOPT = LCOPT - 1
         GOTO 240
C
C L'ITEM EST UN POINT-VIRGULE
C DEVERSER TOUTE LA PILE DANS LA QUEUE ET RETOURNER
      ELSE IF (NITEM.EQ.40 001) THEN
  250    IF (LCOPT .LE. 1) THEN
            CALL FONAIT(50 002,MEXP,MOPN,ICODE)
            IF (ICODE.NE.0) RETURN
            IF (LCOPN .LT. LCOPNI+1) THEN
               ICODE = 11
               RETURN
            END IF
            IF (LCOPN .GT. LCOPNI+1) THEN
               ICODE = 12
               RETURN
            END IF
            CALL FONDID(LCOPNI)
            ICODE = 0
            RETURN
         END IF
         IF (MOPT(LCOPT) .EQ. 40 002) THEN
            ICODE = 8
            RETURN
         ELSE
            CALL FONAIT(MOPT(LCOPT),MEXP,MOPN,ICODE)
            IF (ICODE.NE.0) RETURN
         END IF
         LCOPT = LCOPT - 1
         GOTO 250
C
C L'ITEM EST UN OPERATEUR OU UNE PARENTHESE OUVRANTE
C 1ER CAS : ENLEVER L'OPERATEUR DE LA PILE ET L'AJOUTER DANS LA QUEUE
      ELSE
         CALL FONDOP(NITEM, INFIX1, IPRIO1)
         IF (INFIX1.NE.0) THEN
  300       CALL FONDOP(MOPT(LCOPT), INFIX2, IPRIO2)
            IF (IPRIO1 .LE. IPRIO2) THEN
               CALL FONAIT(MOPT(LCOPT),MEXP,MOPN,ICODE)
               IF (ICODE.NE.0) RETURN
               LCOPT = LCOPT - 1
               GOTO 300
            END IF
         END IF
C
C 2E CAS : METTRE L'OPERATEUR DANS LA PILE
         LCOPT = LCOPT + 1
         IF (LCOPT .GT. LMOPT) THEN
            ICODE = 9
            RETURN
         END IF
         MOPT(LCOPT) = NITEM
         GOTO 100
      END IF
      END
