SUBROUTINE SYNERR(MESSA0)
      INTEGER MESSA0(1)
      INTEGER SYMTE0(200),SYMLO0(200)
      INTEGER SYMLE0,SYMBO0
      INTEGER IDTAB0,UNAME0
      COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0
      INTEGER INBUF0(505)
      INTEGER IBPAA0,LINEN0(5),LEVEL0
      INTEGER INFIL0(5)
      COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0
      INTEGER LOOPS0,NEXTL0(10),BREAK0(10)
      COMMON /LOOPC0/LOOPS0,NEXTL0,BREAK0
      INTEGER OUTBU0(102,3)
      INTEGER OUTPA0(3)
      COMMON /OBUFC0/OUTBU0,OUTPA0
      INTEGER MEMAA0(25000)
      COMMON /DS$MEM/MEMAA0
      INTEGER OUTFI0(3),FORTF0
      COMMON /OUTFIL/OUTFI0,FORTF0
      INTEGER EXPRS0(20),EXPRT0,FALSE0
      COMMON /CODEG0/EXPRS0,EXPRT0,FALSE0
      INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10)
      COMMON /SELGEN/SCVAL0,SCLAB0,SCLAA0,RESUL0
      INTEGER SCOPE0
      INTEGER SCOPF0(100),PROCH0,PROCT0
      COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0
      INTEGER MODUL0(200),MODUM0(200),ERROR0(200)
      INTEGER CURLA0,BRACE0,DISPA0,INDEN0,FIRST0,SPNUM0
      INTEGER PROFD0
      INTEGER A$BUF(200)
      COMMON /MISCOM/MODUL0,CURLA0,BRACE0,DISPA0,INDEN0,MODUM0,FIRST0,PR
     *OFD0,SPNUM0,ERROR0,A$BUF
      INTEGER I,J,NL,EL,ML
      INTEGER ENCODE,CTOC,PTOC
      INTEGER NUMS(102),MSG(102)
      INTEGER AAAAA0(4)
      INTEGER AAAAB0(8)
      INTEGER AAAAC0(10)
      INTEGER AAAAD0(6)
      INTEGER AAAAE0(8)
      INTEGER AAAAF0(13)
      INTEGER AAAAG0(18)
      DATA AAAAA0/170,181,233,0/
      DATA AAAAB0/160,168,170,243,169,186,160,0/
      DATA AAAAC0/188,206,197,215,204,201,206,197,190,0/
      DATA AAAAD0/188,197,207,198,190,0/
      DATA AAAAE0/170,243,170,243,174,170,238,0/
      DATA AAAAF0/170,243,167,170,243,167,160,170,243,174,170,238,0/
      DATA AAAAG0/170,243,167,170,243,167,170,238,170,177,176,248,170,24
     *3,174,170,238,0/
      NL=1
      I=1
      GOTO 10002
10000 I=I+1
10002 IF((I.GT.LEVEL0))GOTO 10001
        NL=NL+(ENCODE(NUMS(NL),102-NL,AAAAA0,LINEN0(I)))
      GOTO 10000
10001 NL=NL+(ENCODE(NUMS(NL),102-NL,AAAAB0,MODUM0))
      ML=PTOC(MESSA0,174,MSG,102)
      EL=LENGTH(ERROR0)
      IF((EL.NE.0))GOTO 10003
        IF((SYMBO0.NE.1023))GOTO 10004
          CALL GETLO0(ERROR0)
          EL=LENGTH(ERROR0)
          GOTO 10005
10004     IF((SYMBO0.NE.138))GOTO 10006
            EL=CTOC(AAAAC0,ERROR0,200)
            GOTO 10007
10006       IF((SYMBO0.NE.-1))GOTO 10008
              EL=CTOC(AAAAD0,ERROR0,200)
              GOTO 10009
10008         IF((SYMTE0(SYMLE0+1).NE.0))GOTO 10010
                EL=CTOC(SYMTE0,ERROR0,200)
10010       CONTINUE
10009     CONTINUE
10007   CONTINUE
10005 CONTINUE
10003 IF((EL.NE.0))GOTO 10011
        CALL PRINT(-15,AAAAE0,NUMS,MSG)
        GOTO 10012
10011   IF((EL+NL+ML.GT.73))GOTO 10013
          CALL PRINT(-15,AAAAF0,NUMS,ERROR0,MSG)
          GOTO 10014
10013     CALL PRINT(-15,AAAAG0,NUMS,ERROR0,MSG)
10014 CONTINUE
10012 ERROR0(1)=0
      RETURN
      END
      SUBROUTINE FATAL0(MSG)
      INTEGER MSG(1)
      CALL SYNERR(MSG)
      CALL CLEAN0
      CALL ERROR('program terminated.')
      END
      INTEGER FUNCTION SDUPL(STR)
      INTEGER STR(1)
      INTEGER SYMTE0(200),SYMLO0(200)
      INTEGER SYMLE0,SYMBO0
      INTEGER IDTAB0,UNAME0
      COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0
      INTEGER INBUF0(505)
      INTEGER IBPAA0,LINEN0(5),LEVEL0
      INTEGER INFIL0(5)
      COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0
      INTEGER LOOPS0,NEXTL0(10),BREAK0(10)
      COMMON /LOOPC0/LOOPS0,NEXTL0,BREAK0
      INTEGER OUTBU0(102,3)
      INTEGER OUTPA0(3)
      COMMON /OBUFC0/OUTBU0,OUTPA0
      INTEGER MEMAA0(25000)
      COMMON /DS$MEM/MEMAA0
      INTEGER OUTFI0(3),FORTF0
      COMMON /OUTFIL/OUTFI0,FORTF0
      INTEGER EXPRS0(20),EXPRT0,FALSE0
      COMMON /CODEG0/EXPRS0,EXPRT0,FALSE0
      INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10)
      COMMON /SELGEN/SCVAL0,SCLAB0,SCLAA0,RESUL0
      INTEGER SCOPE0
      INTEGER SCOPF0(100),PROCH0,PROCT0
      COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0
      INTEGER MODUL0(200),MODUM0(200),ERROR0(200)
      INTEGER CURLA0,BRACE0,DISPA0,INDEN0,FIRST0,SPNUM0
      INTEGER PROFD0
      INTEGER A$BUF(200)
      COMMON /MISCOM/MODUL0,CURLA0,BRACE0,DISPA0,INDEN0,MODUM0,FIRST0,PR
     *OFD0,SPNUM0,ERROR0,A$BUF
      INTEGER LENGTH
      INTEGER DSGET
      SDUPL=DSGET(LENGTH(STR)+1)
      CALL SCOPY(STR,1,MEMAA0,SDUPL)
      RETURN
      END
      SUBROUTINE ENTET0
      INTEGER SYMTE0(200),SYMLO0(200)
      INTEGER SYMLE0,SYMBO0
      INTEGER IDTAB0,UNAME0
      COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0
      INTEGER INBUF0(505)
      INTEGER IBPAA0,LINEN0(5),LEVEL0
      INTEGER INFIL0(5)
      COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0
      INTEGER LOOPS0,NEXTL0(10),BREAK0(10)
      COMMON /LOOPC0/LOOPS0,NEXTL0,BREAK0
      INTEGER OUTBU0(102,3)
      INTEGER OUTPA0(3)
      COMMON /OBUFC0/OUTBU0,OUTPA0
      INTEGER MEMAA0(25000)
      COMMON /DS$MEM/MEMAA0
      INTEGER OUTFI0(3),FORTF0
      COMMON /OUTFIL/OUTFI0,FORTF0
      INTEGER EXPRS0(20),EXPRT0,FALSE0
      COMMON /CODEG0/EXPRS0,EXPRT0,FALSE0
      INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10)
      COMMON /SELGEN/SCVAL0,SCLAB0,SCLAA0,RESUL0
      INTEGER SCOPE0
      INTEGER SCOPF0(100),PROCH0,PROCT0
      COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0
      INTEGER MODUL0(200),MODUM0(200),ERROR0(200)
      INTEGER CURLA0,BRACE0,DISPA0,INDEN0,FIRST0,SPNUM0
      INTEGER PROFD0
      INTEGER A$BUF(200)
      COMMON /MISCOM/MODUL0,CURLA0,BRACE0,DISPA0,INDEN0,MODUM0,FIRST0,PR
     *OFD0,SPNUM0,ERROR0,A$BUF
      INTEGER MAKEU0
      INTEGER SCOPY
      INTEGER UNIQU0(200)
      INTEGER SDUPL
      INTEGER INFO(3)
      IF((MAKEU0(SYMTE0,UNIQU0).NE.1))GOTO 10015
        INFO(1)=2
        INFO(3)=SDUPL(UNIQU0)
        CALL ENTER(SYMTE0,INFO,IDTAB0)
        CALL ENTER(UNIQU0,0,UNAME0)
        SYMLE0=SCOPY(UNIQU0,1,SYMTE0,1)
        GOTO 10016
10015   CALL SYNERR('identifier cannot be made unique.')
10016 RETURN
      END
      INTEGER FUNCTION MAKEU0(ID,UID)
      INTEGER ID(200),UID(200)
      INTEGER SYMTE0(200),SYMLO0(200)
      INTEGER SYMLE0,SYMBO0
      INTEGER IDTAB0,UNAME0
      COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0
      INTEGER INBUF0(505)
      INTEGER IBPAA0,LINEN0(5),LEVEL0
      INTEGER INFIL0(5)
      COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0
      INTEGER LOOPS0,NEXTL0(10),BREAK0(10)
      COMMON /LOOPC0/LOOPS0,NEXTL0,BREAK0
      INTEGER OUTBU0(102,3)
      INTEGER OUTPA0(3)
      COMMON /OBUFC0/OUTBU0,OUTPA0
      INTEGER MEMAA0(25000)
      COMMON /DS$MEM/MEMAA0
      INTEGER OUTFI0(3),FORTF0
      COMMON /OUTFIL/OUTFI0,FORTF0
      INTEGER EXPRS0(20),EXPRT0,FALSE0
      COMMON /CODEG0/EXPRS0,EXPRT0,FALSE0
      INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10)
      COMMON /SELGEN/SCVAL0,SCLAB0,SCLAA0,RESUL0
      INTEGER SCOPE0
      INTEGER SCOPF0(100),PROCH0,PROCT0
      COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0
      INTEGER MODUL0(200),MODUM0(200),ERROR0(200)
      INTEGER CURLA0,BRACE0,DISPA0,INDEN0,FIRST0,SPNUM0
      INTEGER PROFD0
      INTEGER A$BUF(200)
      COMMON /MISCOM/MODUL0,CURLA0,BRACE0,DISPA0,INDEN0,MODUM0,FIRST0,PR
     *OFD0,SPNUM0,ERROR0,A$BUF
      INTEGER I,JUNK
      INTEGER LOOKUP
      I=1
      GOTO 10019
10017 I=I+1
10019 IF((I.GT.6))GOTO 10018
      IF((ID(I).EQ.0))GOTO 10018
        IF((193.GT.ID(I)))GOTO 10020
        IF((ID(I).GT.218))GOTO 10020
          UID(I)=ID(I)-193+225
          GOTO 10021
10020     UID(I)=ID(I)
10021 GOTO 10017
10018 GOTO 10024
10022 I=I+1
10024 IF((I.GT.6))GOTO 10023
        UID(I)=225
      GOTO 10022
10023 UID(6+1)=0
      UID(6)=176
10025 IF((LOOKUP(UID,JUNK,UNAME0).NE.1))GOTO 10026
        I=6-1
        GOTO 10029
10027   I=I-1
10029   IF((I.LE.1))GOTO 10028
          IF((225.GT.UID(I)))GOTO 10030
          IF((UID(I).GE.250))GOTO 10030
            UID(I)=UID(I)+(1)
            I=I+1
            GOTO 10033
10031       I=I+1
10033       IF((I.GT.6-1))GOTO 10032
              UID(I)=225
            GOTO 10031
10032       GOTO 10028
10030   GOTO 10027
10028   IF((I.NE.1))GOTO 10034
          MAKEU0=0
          RETURN
10034 GOTO 10025
10026 MAKEU0=1
      RETURN
      END
      INTEGER FUNCTION LABGEN(N)
      INTEGER N
      INTEGER SYMTE0(200),SYMLO0(200)
      INTEGER SYMLE0,SYMBO0
      INTEGER IDTAB0,UNAME0
      COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0
      INTEGER INBUF0(505)
      INTEGER IBPAA0,LINEN0(5),LEVEL0
      INTEGER INFIL0(5)
      COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0
      INTEGER LOOPS0,NEXTL0(10),BREAK0(10)
      COMMON /LOOPC0/LOOPS0,NEXTL0,BREAK0
      INTEGER OUTBU0(102,3)
      INTEGER OUTPA0(3)
      COMMON /OBUFC0/OUTBU0,OUTPA0
      INTEGER MEMAA0(25000)
      COMMON /DS$MEM/MEMAA0
      INTEGER OUTFI0(3),FORTF0
      COMMON /OUTFIL/OUTFI0,FORTF0
      INTEGER EXPRS0(20),EXPRT0,FALSE0
      COMMON /CODEG0/EXPRS0,EXPRT0,FALSE0
      INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10)
      COMMON /SELGEN/SCVAL0,SCLAB0,SCLAA0,RESUL0
      INTEGER SCOPE0
      INTEGER SCOPF0(100),PROCH0,PROCT0
      COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0
      INTEGER MODUL0(200),MODUM0(200),ERROR0(200)
      INTEGER CURLA0,BRACE0,DISPA0,INDEN0,FIRST0,SPNUM0
      INTEGER PROFD0
      INTEGER A$BUF(200)
      COMMON /MISCOM/MODUL0,CURLA0,BRACE0,DISPA0,INDEN0,MODUM0,FIRST0,PR
     *OFD0,SPNUM0,ERROR0,A$BUF
      LABGEN=CURLA0
      CURLA0=CURLA0+N
      RETURN
      END
      SUBROUTINE VARGEN(NAME)
      INTEGER NAME(1)
      INTEGER SYMTE0(200),SYMLO0(200)
      INTEGER SYMLE0,SYMBO0
      INTEGER IDTAB0,UNAME0
      COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0
      INTEGER INBUF0(505)
      INTEGER IBPAA0,LINEN0(5),LEVEL0
      INTEGER INFIL0(5)
      COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0
      INTEGER LOOPS0,NEXTL0(10),BREAK0(10)
      COMMON /LOOPC0/LOOPS0,NEXTL0,BREAK0
      INTEGER OUTBU0(102,3)
      INTEGER OUTPA0(3)
      COMMON /OBUFC0/OUTBU0,OUTPA0
      INTEGER MEMAA0(25000)
      COMMON /DS$MEM/MEMAA0
      INTEGER OUTFI0(3),FORTF0
      COMMON /OUTFIL/OUTFI0,FORTF0
      INTEGER EXPRS0(20),EXPRT0,FALSE0
      COMMON /CODEG0/EXPRS0,EXPRT0,FALSE0
      INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10)
      COMMON /SELGEN/SCVAL0,SCLAB0,SCLAA0,RESUL0
      INTEGER SCOPE0
      INTEGER SCOPF0(100),PROCH0,PROCT0
      COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0
      INTEGER MODUL0(200),MODUM0(200),ERROR0(200)
      INTEGER CURLA0,BRACE0,DISPA0,INDEN0,FIRST0,SPNUM0
      INTEGER PROFD0
      INTEGER A$BUF(200)
      COMMON /MISCOM/MODUL0,CURLA0,BRACE0,DISPA0,INDEN0,MODUM0,FIRST0,PR
     *OFD0,SPNUM0,ERROR0,A$BUF
      INTEGER MAKEU0
      IF((MAKEU0(0,NAME).NE.1))GOTO 10035
        CALL ENTER(NAME,0,UNAME0)
        GOTO 10036
10035   CALL SYNERR('in vargen:  cannot generate new variable.')
        NAME(1)=0
10036 RETURN
      END
      SUBROUTINE SAVEM0
      INTEGER SYMTE0(200),SYMLO0(200)
      INTEGER SYMLE0,SYMBO0
      INTEGER IDTAB0,UNAME0
      COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0
      INTEGER INBUF0(505)
      INTEGER IBPAA0,LINEN0(5),LEVEL0
      INTEGER INFIL0(5)
      COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0
      INTEGER LOOPS0,NEXTL0(10),BREAK0(10)
      COMMON /LOOPC0/LOOPS0,NEXTL0,BREAK0
      INTEGER OUTBU0(102,3)
      INTEGER OUTPA0(3)
      COMMON /OBUFC0/OUTBU0,OUTPA0
      INTEGER MEMAA0(25000)
      COMMON /DS$MEM/MEMAA0
      INTEGER OUTFI0(3),FORTF0
      COMMON /OUTFIL/OUTFI0,FORTF0
      INTEGER EXPRS0(20),EXPRT0,FALSE0
      COMMON /CODEG0/EXPRS0,EXPRT0,FALSE0
      INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10)
      COMMON /SELGEN/SCVAL0,SCLAB0,SCLAA0,RESUL0
      INTEGER SCOPE0
      INTEGER SCOPF0(100),PROCH0,PROCT0
      COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0
      INTEGER MODUL0(200),MODUM0(200),ERROR0(200)
      INTEGER CURLA0,BRACE0,DISPA0,INDEN0,FIRST0,SPNUM0
      INTEGER PROFD0
      INTEGER A$BUF(200)
      COMMON /MISCOM/MODUL0,CURLA0,BRACE0,DISPA0,INDEN0,MODUM0,FIRST0,PR
     *OFD0,SPNUM0,ERROR0,A$BUF
      CALL SCOPY(SYMTE0,1,MODUL0,1)
      CALL GETLO0(MODUM0)
      RETURN
      END
      SUBROUTINE GETLO0(STR)
      INTEGER STR(1)
      INTEGER SYMTE0(200),SYMLO0(200)
      INTEGER SYMLE0,SYMBO0
      INTEGER IDTAB0,UNAME0
      COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0
      INTEGER INBUF0(505)
      INTEGER IBPAA0,LINEN0(5),LEVEL0
      INTEGER INFIL0(5)
      COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0
      INTEGER LOOPS0,NEXTL0(10),BREAK0(10)
      COMMON /LOOPC0/LOOPS0,NEXTL0,BREAK0
      INTEGER OUTBU0(102,3)
      INTEGER OUTPA0(3)
      COMMON /OBUFC0/OUTBU0,OUTPA0
      INTEGER MEMAA0(25000)
      COMMON /DS$MEM/MEMAA0
      INTEGER OUTFI0(3),FORTF0
      COMMON /OUTFIL/OUTFI0,FORTF0
      INTEGER EXPRS0(20),EXPRT0,FALSE0
      COMMON /CODEG0/EXPRS0,EXPRT0,FALSE0
      INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10)
      COMMON /SELGEN/SCVAL0,SCLAB0,SCLAA0,RESUL0
      INTEGER SCOPE0
      INTEGER SCOPF0(100),PROCH0,PROCT0
      COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0
      INTEGER MODUL0(200),MODUM0(200),ERROR0(200)
      INTEGER CURLA0,BRACE0,DISPA0,INDEN0,FIRST0,SPNUM0
      INTEGER PROFD0
      INTEGER A$BUF(200)
      COMMON /MISCOM/MODUL0,CURLA0,BRACE0,DISPA0,INDEN0,MODUM0,FIRST0,PR
     *OFD0,SPNUM0,ERROR0,A$BUF
      IF((SYMLO0(1).NE.0))GOTO 10037
        CALL SCOPY(SYMTE0,1,STR,1)
        GOTO 10038
10037   CALL SCOPY(SYMLO0,1,STR,1)
10038 RETURN
      END
C ---- Long Name Map ----
C getlinkid                      getli0
C deleteunderscores              delet0
C enterdefinition                enter0
C enterlongname                  entet0
C Fortfile                       fortf0
C Indent                         inden0
C message                        messa0
C Slt                            sltaa0
C compare                        compa0
C cleanup                        clean0
C convertstringconstant          conve0
C putbackstr                     putbc0
C Breaklab                       break0
C putback                        putba0
C obufcom                        obufc0
C invokemacro                    invok0
C Dispatchflag                   dispa0
C Spnum                          spnum0
C Proctable                      proct0
C refillbuffer                   refil0
C savemodulename                 savem0
C Outbuf                         outbu0
C Firststmt                      first0
C Symbol                         symbo0
C Inbuf                          inbuf0
C Ibp                            ibpaa0
C loopcom                        loopc0
C Unametable                     uname0
C Nextlab                        nextl0
C fatalerr                       fatal0
C Symlen                         symle0
C Prochead                       proch0
C removedefinition               remov0
C Symlongtext                    symlo0
C Level                          level0
C Mem                            memaa0
C dgetsym                        dgets0
C Falsebranch                    false0
C Scopetable                     scopf0
C Profdictfile                   profd0
C Symtext                        symte0
C Scvalue                        scval0
C Loopsp                         loops0
C Scl                            sclaa0
C codegen                        codeg0
C enterkw                        entes0
C Modulelongname                 modum0
C Result                         resul0
C Bracecount                     brace0
C initialize                     initi0
C skipwhitespace                 skipw0
C Exprstackptr                   exprt0
C Modulename                     modul0
C getactualparameters            getac0
C Outp                           outpa0
C Outfile                        outfi0
C Infile                         infil0
C makeunique                     makeu0
C collectactualparameter         colle0
C Curlab                         curla0
C Exprstack                      exprs0
C Scopesp                        scope0
C uniquename                     uniqu0
C getdefinition                  getde0
C getformalparameters            getfo0
C getlongname                    getlo0
C putbacknum                     putbb0
C Idtable                        idtab0
C Linenumber                     linen0
C Sclabel                        sclab0
C Errorsym                       error0