SUBROUTINE SYNERR(MESSA0) INTEGER MESSA0(1) INTEGER SYMTE0(200),SYMLO0(200),LASTV0(200) INTEGER SYMLE0,SYMBO0 INTEGER IDTAB0,UNAME0 COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0,LASTV0 INTEGER INBUF0(505) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER LOOPS0,NEXTL0(10),BREAL0(10) COMMON /LOOPC0/LOOPS0,NEXTL0,BREAL0 INTEGER OUTBU0(128,4) INTEGER OUTPA0(4) COMMON /OBUFC0/OUTBU0,OUTPA0 INTEGER MEMAA0(32767) COMMON /DS$MEM/MEMAA0 INTEGER OUTFI0(4),FORTF0 COMMON /OUTFIL/OUTFI0,FORTF0 INTEGER EXPRU0(20),EXPRV0,FALSE0 COMMON /CODEG0/EXPRU0,EXPRV0,FALSE0 INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10) COMMON /SELGEN/SCVAL0,SCLAB0,SLTAA0,RESUL0 INTEGER SCOPE0 INTEGER SCOPF0(100),PROCH0,PROCT0 COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0 INTEGER DISPA0,LASTD0,XGOFR0(407),XGOTO0(407),LGOLI0(1000),LGOPO0( *1000),LGOST0(1000),LGOLP0 COMMON /GOCOM/DISPA0,LASTD0,XGOFR0,XGOTO0,LGOLI0,LGOPO0,LGOST0,LGO *LP0 INTEGER MODUL0(200),MODUM0(200),ERROR0(200),TLITC0(256),TLITE0 INTEGER CURLA0,BRACE0,INDEN0,FIRST0,SPNUM0,LASTN0,CODEL0 INTEGER PROFD0 INTEGER A$BUF(200) COMMON /MISCOM/MODUL0,CURLA0,BRACE0,INDEN0,MODUM0,FIRST0,PROFD0,SP *NUM0,ERROR0,A$BUF,LASTN0,CODEL0,TLITC0,TLITE0 INTEGER I,NL,EL,ML INTEGER ENCODE,CTOC,PTOC,LENGTH INTEGER NUMS(128),MSG(128) INTEGER AAAAA0(4) INTEGER AAAAB0(8) INTEGER AAAAC0(10) INTEGER AAAAD0(6) INTEGER AAAAE0(8) INTEGER AAAAF0(13) INTEGER AAAAG0(18) INTEGER AAAAH0(17) 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/ DATA AAAAH0/210,225,244,230,239,242,160,229,242,242,239,242,160,22 *5,244,160,0/ NL=1 I=1 GOTO 10002 10000 I=I+(1) 10002 IF((I.GT.LEVEL0))GOTO 10001 NL=NL+(ENCODE(NUMS(NL),128-NL,AAAAA0,LINEN0(I))) GOTO 10000 10001 NL=NL+(ENCODE(NUMS(NL),128-NL,AAAAB0,MODUM0)) ML=PTOC(MESSA0,174,MSG,128) EL=LENGTH(ERROR0) IF((EL.NE.0))GOTO 10003 IF((SYMBO0.NE.1024))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 CALL OUTDON(3) CALL OUTTAB(3) CALL OUTSTR(AAAAH0,3) I=1 GOTO 10017 10015 I=I+(1) 10017 IF((I.GT.LEVEL0))GOTO 10016 CALL OUTNUM(LINEN0(I),3) CALL OUTCH(160,3) GOTO 10015 10016 CALL OUTSTR(MSG,3) CALL OUTDON(3) ERROR0(1)=0 IF((A$BUF(225-225+1).EQ.0))GOTO 10018 CALL SETERR(1) 10018 RETURN END SUBROUTINE FATAL0(MSG) INTEGER MSG(1) CALL SYNERR(MSG) CALL CLEAN0 CALL ERROR('program terminated.') RETURN END INTEGER FUNCTION SDUPL(STR) INTEGER STR(1) INTEGER SYMTE0(200),SYMLO0(200),LASTV0(200) INTEGER SYMLE0,SYMBO0 INTEGER IDTAB0,UNAME0 COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0,LASTV0 INTEGER INBUF0(505) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER LOOPS0,NEXTL0(10),BREAL0(10) COMMON /LOOPC0/LOOPS0,NEXTL0,BREAL0 INTEGER OUTBU0(128,4) INTEGER OUTPA0(4) COMMON /OBUFC0/OUTBU0,OUTPA0 INTEGER MEMAA0(32767) COMMON /DS$MEM/MEMAA0 INTEGER OUTFI0(4),FORTF0 COMMON /OUTFIL/OUTFI0,FORTF0 INTEGER EXPRU0(20),EXPRV0,FALSE0 COMMON /CODEG0/EXPRU0,EXPRV0,FALSE0 INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10) COMMON /SELGEN/SCVAL0,SCLAB0,SLTAA0,RESUL0 INTEGER SCOPE0 INTEGER SCOPF0(100),PROCH0,PROCT0 COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0 INTEGER DISPA0,LASTD0,XGOFR0(407),XGOTO0(407),LGOLI0(1000),LGOPO0( *1000),LGOST0(1000),LGOLP0 COMMON /GOCOM/DISPA0,LASTD0,XGOFR0,XGOTO0,LGOLI0,LGOPO0,LGOST0,LGO *LP0 INTEGER MODUL0(200),MODUM0(200),ERROR0(200),TLITC0(256),TLITE0 INTEGER CURLA0,BRACE0,INDEN0,FIRST0,SPNUM0,LASTN0,CODEL0 INTEGER PROFD0 INTEGER A$BUF(200) COMMON /MISCOM/MODUL0,CURLA0,BRACE0,INDEN0,MODUM0,FIRST0,PROFD0,SP *NUM0,ERROR0,A$BUF,LASTN0,CODEL0,TLITC0,TLITE0 INTEGER LENGTH INTEGER DSGET SDUPL=DSGET(LENGTH(STR)+1) CALL SCOPY(STR,1,MEMAA0,SDUPL) RETURN END SUBROUTINE ENTET0 INTEGER SYMTE0(200),SYMLO0(200),LASTV0(200) INTEGER SYMLE0,SYMBO0 INTEGER IDTAB0,UNAME0 COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0,LASTV0 INTEGER INBUF0(505) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER LOOPS0,NEXTL0(10),BREAL0(10) COMMON /LOOPC0/LOOPS0,NEXTL0,BREAL0 INTEGER OUTBU0(128,4) INTEGER OUTPA0(4) COMMON /OBUFC0/OUTBU0,OUTPA0 INTEGER MEMAA0(32767) COMMON /DS$MEM/MEMAA0 INTEGER OUTFI0(4),FORTF0 COMMON /OUTFIL/OUTFI0,FORTF0 INTEGER EXPRU0(20),EXPRV0,FALSE0 COMMON /CODEG0/EXPRU0,EXPRV0,FALSE0 INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10) COMMON /SELGEN/SCVAL0,SCLAB0,SLTAA0,RESUL0 INTEGER SCOPE0 INTEGER SCOPF0(100),PROCH0,PROCT0 COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0 INTEGER DISPA0,LASTD0,XGOFR0(407),XGOTO0(407),LGOLI0(1000),LGOPO0( *1000),LGOST0(1000),LGOLP0 COMMON /GOCOM/DISPA0,LASTD0,XGOFR0,XGOTO0,LGOLI0,LGOPO0,LGOST0,LGO *LP0 INTEGER MODUL0(200),MODUM0(200),ERROR0(200),TLITC0(256),TLITE0 INTEGER CURLA0,BRACE0,INDEN0,FIRST0,SPNUM0,LASTN0,CODEL0 INTEGER PROFD0 INTEGER A$BUF(200) COMMON /MISCOM/MODUL0,CURLA0,BRACE0,INDEN0,MODUM0,FIRST0,PROFD0,SP *NUM0,ERROR0,A$BUF,LASTN0,CODEL0,TLITC0,TLITE0 INTEGER MAKEU0 INTEGER SCOPY INTEGER UNIQU0(200) INTEGER SDUPL INTEGER INFO(3) IF((MAKEU0(SYMTE0,UNIQU0).NE.1))GOTO 10019 INFO(1)=2 INFO(3)=SDUPL(UNIQU0) CALL ENTER(SYMTE0,INFO,IDTAB0) CALL ENTER(UNIQU0,0,UNAME0) SYMLE0=SCOPY(UNIQU0,1,SYMTE0,1) GOTO 10020 10019 CALL SYNERR('identifier cannot be made unique.') 10020 RETURN END INTEGER FUNCTION MAKEU0(ID,UID) INTEGER ID(200),UID(200) INTEGER SYMTE0(200),SYMLO0(200),LASTV0(200) INTEGER SYMLE0,SYMBO0 INTEGER IDTAB0,UNAME0 COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0,LASTV0 INTEGER INBUF0(505) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER LOOPS0,NEXTL0(10),BREAL0(10) COMMON /LOOPC0/LOOPS0,NEXTL0,BREAL0 INTEGER OUTBU0(128,4) INTEGER OUTPA0(4) COMMON /OBUFC0/OUTBU0,OUTPA0 INTEGER MEMAA0(32767) COMMON /DS$MEM/MEMAA0 INTEGER OUTFI0(4),FORTF0 COMMON /OUTFIL/OUTFI0,FORTF0 INTEGER EXPRU0(20),EXPRV0,FALSE0 COMMON /CODEG0/EXPRU0,EXPRV0,FALSE0 INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10) COMMON /SELGEN/SCVAL0,SCLAB0,SLTAA0,RESUL0 INTEGER SCOPE0 INTEGER SCOPF0(100),PROCH0,PROCT0 COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0 INTEGER DISPA0,LASTD0,XGOFR0(407),XGOTO0(407),LGOLI0(1000),LGOPO0( *1000),LGOST0(1000),LGOLP0 COMMON /GOCOM/DISPA0,LASTD0,XGOFR0,XGOTO0,LGOLI0,LGOPO0,LGOST0,LGO *LP0 INTEGER MODUL0(200),MODUM0(200),ERROR0(200),TLITC0(256),TLITE0 INTEGER CURLA0,BRACE0,INDEN0,FIRST0,SPNUM0,LASTN0,CODEL0 INTEGER PROFD0 INTEGER A$BUF(200) COMMON /MISCOM/MODUL0,CURLA0,BRACE0,INDEN0,MODUM0,FIRST0,PROFD0,SP *NUM0,ERROR0,A$BUF,LASTN0,CODEL0,TLITC0,TLITE0 INTEGER I,JUNK INTEGER LOOKUP I=1 GOTO 10023 10021 I=I+(1) 10023 IF((I.GT.6))GOTO 10028 IF((ID(I).EQ.0))GOTO 10028 IF((193.GT.ID(I)))GOTO 10024 IF((ID(I).GT.218))GOTO 10024 UID(I)=ID(I)-193+225 GOTO 10021 10024 UID(I)=ID(I) 10025 GOTO 10021 10026 I=I+(1) 10028 IF((I.GT.6))GOTO 10027 UID(I)=225 GOTO 10026 10027 UID(6+1)=0 UID(6)=176 10029 IF((LOOKUP(UID,JUNK,UNAME0).NE.1))GOTO 10030 I=6-1 GOTO 10033 10031 I=I-(1) 10033 IF((I.LE.1))GOTO 10032 IF((225.GT.UID(I)))GOTO 10031 IF((UID(I).GE.250))GOTO 10031 UID(I)=UID(I)+(1) I=I+(1) GOTO 10037 10035 I=I+(1) 10037 IF((I.GT.6-1))GOTO 10032 UID(I)=225 GOTO 10035 10032 IF((I.NE.1))GOTO 10029 MAKEU0=0 RETURN 10030 MAKEU0=1 RETURN END INTEGER FUNCTION LABGEN(N) INTEGER N INTEGER SYMTE0(200),SYMLO0(200),LASTV0(200) INTEGER SYMLE0,SYMBO0 INTEGER IDTAB0,UNAME0 COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0,LASTV0 INTEGER INBUF0(505) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER LOOPS0,NEXTL0(10),BREAL0(10) COMMON /LOOPC0/LOOPS0,NEXTL0,BREAL0 INTEGER OUTBU0(128,4) INTEGER OUTPA0(4) COMMON /OBUFC0/OUTBU0,OUTPA0 INTEGER MEMAA0(32767) COMMON /DS$MEM/MEMAA0 INTEGER OUTFI0(4),FORTF0 COMMON /OUTFIL/OUTFI0,FORTF0 INTEGER EXPRU0(20),EXPRV0,FALSE0 COMMON /CODEG0/EXPRU0,EXPRV0,FALSE0 INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10) COMMON /SELGEN/SCVAL0,SCLAB0,SLTAA0,RESUL0 INTEGER SCOPE0 INTEGER SCOPF0(100),PROCH0,PROCT0 COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0 INTEGER DISPA0,LASTD0,XGOFR0(407),XGOTO0(407),LGOLI0(1000),LGOPO0( *1000),LGOST0(1000),LGOLP0 COMMON /GOCOM/DISPA0,LASTD0,XGOFR0,XGOTO0,LGOLI0,LGOPO0,LGOST0,LGO *LP0 INTEGER MODUL0(200),MODUM0(200),ERROR0(200),TLITC0(256),TLITE0 INTEGER CURLA0,BRACE0,INDEN0,FIRST0,SPNUM0,LASTN0,CODEL0 INTEGER PROFD0 INTEGER A$BUF(200) COMMON /MISCOM/MODUL0,CURLA0,BRACE0,INDEN0,MODUM0,FIRST0,PROFD0,SP *NUM0,ERROR0,A$BUF,LASTN0,CODEL0,TLITC0,TLITE0 LABGEN=CURLA0 CURLA0=CURLA0+(N) RETURN END SUBROUTINE VARGEN(NAME) INTEGER NAME(1) INTEGER SYMTE0(200),SYMLO0(200),LASTV0(200) INTEGER SYMLE0,SYMBO0 INTEGER IDTAB0,UNAME0 COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0,LASTV0 INTEGER INBUF0(505) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER LOOPS0,NEXTL0(10),BREAL0(10) COMMON /LOOPC0/LOOPS0,NEXTL0,BREAL0 INTEGER OUTBU0(128,4) INTEGER OUTPA0(4) COMMON /OBUFC0/OUTBU0,OUTPA0 INTEGER MEMAA0(32767) COMMON /DS$MEM/MEMAA0 INTEGER OUTFI0(4),FORTF0 COMMON /OUTFIL/OUTFI0,FORTF0 INTEGER EXPRU0(20),EXPRV0,FALSE0 COMMON /CODEG0/EXPRU0,EXPRV0,FALSE0 INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10) COMMON /SELGEN/SCVAL0,SCLAB0,SLTAA0,RESUL0 INTEGER SCOPE0 INTEGER SCOPF0(100),PROCH0,PROCT0 COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0 INTEGER DISPA0,LASTD0,XGOFR0(407),XGOTO0(407),LGOLI0(1000),LGOPO0( *1000),LGOST0(1000),LGOLP0 COMMON /GOCOM/DISPA0,LASTD0,XGOFR0,XGOTO0,LGOLI0,LGOPO0,LGOST0,LGO *LP0 INTEGER MODUL0(200),MODUM0(200),ERROR0(200),TLITC0(256),TLITE0 INTEGER CURLA0,BRACE0,INDEN0,FIRST0,SPNUM0,LASTN0,CODEL0 INTEGER PROFD0 INTEGER A$BUF(200) COMMON /MISCOM/MODUL0,CURLA0,BRACE0,INDEN0,MODUM0,FIRST0,PROFD0,SP *NUM0,ERROR0,A$BUF,LASTN0,CODEL0,TLITC0,TLITE0 INTEGER MAKEU0 IF((MAKEU0(LASTV0,NAME).NE.1))GOTO 10039 CALL ENTER(NAME,0,UNAME0) CALL CTOC(NAME,LASTV0,200) GOTO 10040 10039 CALL SYNERR('in vargen: cannot generate new variable.') NAME(1)=0 10040 RETURN END SUBROUTINE SAVEM0 INTEGER SYMTE0(200),SYMLO0(200),LASTV0(200) INTEGER SYMLE0,SYMBO0 INTEGER IDTAB0,UNAME0 COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0,LASTV0 INTEGER INBUF0(505) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER LOOPS0,NEXTL0(10),BREAL0(10) COMMON /LOOPC0/LOOPS0,NEXTL0,BREAL0 INTEGER OUTBU0(128,4) INTEGER OUTPA0(4) COMMON /OBUFC0/OUTBU0,OUTPA0 INTEGER MEMAA0(32767) COMMON /DS$MEM/MEMAA0 INTEGER OUTFI0(4),FORTF0 COMMON /OUTFIL/OUTFI0,FORTF0 INTEGER EXPRU0(20),EXPRV0,FALSE0 COMMON /CODEG0/EXPRU0,EXPRV0,FALSE0 INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10) COMMON /SELGEN/SCVAL0,SCLAB0,SLTAA0,RESUL0 INTEGER SCOPE0 INTEGER SCOPF0(100),PROCH0,PROCT0 COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0 INTEGER DISPA0,LASTD0,XGOFR0(407),XGOTO0(407),LGOLI0(1000),LGOPO0( *1000),LGOST0(1000),LGOLP0 COMMON /GOCOM/DISPA0,LASTD0,XGOFR0,XGOTO0,LGOLI0,LGOPO0,LGOST0,LGO *LP0 INTEGER MODUL0(200),MODUM0(200),ERROR0(200),TLITC0(256),TLITE0 INTEGER CURLA0,BRACE0,INDEN0,FIRST0,SPNUM0,LASTN0,CODEL0 INTEGER PROFD0 INTEGER A$BUF(200) COMMON /MISCOM/MODUL0,CURLA0,BRACE0,INDEN0,MODUM0,FIRST0,PROFD0,SP *NUM0,ERROR0,A$BUF,LASTN0,CODEL0,TLITC0,TLITE0 CALL SCOPY(SYMTE0,1,MODUL0,1) CALL GETLO0(MODUM0) RETURN END SUBROUTINE GETLO0(STR) INTEGER STR(1) INTEGER SYMTE0(200),SYMLO0(200),LASTV0(200) INTEGER SYMLE0,SYMBO0 INTEGER IDTAB0,UNAME0 COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0,LASTV0 INTEGER INBUF0(505) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER LOOPS0,NEXTL0(10),BREAL0(10) COMMON /LOOPC0/LOOPS0,NEXTL0,BREAL0 INTEGER OUTBU0(128,4) INTEGER OUTPA0(4) COMMON /OBUFC0/OUTBU0,OUTPA0 INTEGER MEMAA0(32767) COMMON /DS$MEM/MEMAA0 INTEGER OUTFI0(4),FORTF0 COMMON /OUTFIL/OUTFI0,FORTF0 INTEGER EXPRU0(20),EXPRV0,FALSE0 COMMON /CODEG0/EXPRU0,EXPRV0,FALSE0 INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10) COMMON /SELGEN/SCVAL0,SCLAB0,SLTAA0,RESUL0 INTEGER SCOPE0 INTEGER SCOPF0(100),PROCH0,PROCT0 COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0 INTEGER DISPA0,LASTD0,XGOFR0(407),XGOTO0(407),LGOLI0(1000),LGOPO0( *1000),LGOST0(1000),LGOLP0 COMMON /GOCOM/DISPA0,LASTD0,XGOFR0,XGOTO0,LGOLI0,LGOPO0,LGOST0,LGO *LP0 INTEGER MODUL0(200),MODUM0(200),ERROR0(200),TLITC0(256),TLITE0 INTEGER CURLA0,BRACE0,INDEN0,FIRST0,SPNUM0,LASTN0,CODEL0 INTEGER PROFD0 INTEGER A$BUF(200) COMMON /MISCOM/MODUL0,CURLA0,BRACE0,INDEN0,MODUM0,FIRST0,PROFD0,SP *NUM0,ERROR0,A$BUF,LASTN0,CODEL0,TLITC0,TLITE0 IF((SYMLO0(1).NE.0))GOTO 10041 CALL SCOPY(SYMTE0,1,STR,1) GOTO 10042 10041 CALL SCOPY(SYMLO0,1,STR,1) 10042 RETURN END SUBROUTINE GENCH0(VAR,INDEX,VALUE) INTEGER VAR(1) INTEGER INDEX,VALUE INTEGER TLIT CALL GENDB0(VAR,INDEX,TLIT(VALUE)) RETURN END SUBROUTINE GENDB0(VAR,INDEX,VALUE) INTEGER VAR(1) INTEGER INDEX,VALUE INTEGER SYMTE0(200),SYMLO0(200),LASTV0(200) INTEGER SYMLE0,SYMBO0 INTEGER IDTAB0,UNAME0 COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0,LASTV0 INTEGER INBUF0(505) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER LOOPS0,NEXTL0(10),BREAL0(10) COMMON /LOOPC0/LOOPS0,NEXTL0,BREAL0 INTEGER OUTBU0(128,4) INTEGER OUTPA0(4) COMMON /OBUFC0/OUTBU0,OUTPA0 INTEGER MEMAA0(32767) COMMON /DS$MEM/MEMAA0 INTEGER OUTFI0(4),FORTF0 COMMON /OUTFIL/OUTFI0,FORTF0 INTEGER EXPRU0(20),EXPRV0,FALSE0 COMMON /CODEG0/EXPRU0,EXPRV0,FALSE0 INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10) COMMON /SELGEN/SCVAL0,SCLAB0,SLTAA0,RESUL0 INTEGER SCOPE0 INTEGER SCOPF0(100),PROCH0,PROCT0 COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0 INTEGER DISPA0,LASTD0,XGOFR0(407),XGOTO0(407),LGOLI0(1000),LGOPO0( *1000),LGOST0(1000),LGOLP0 COMMON /GOCOM/DISPA0,LASTD0,XGOFR0,XGOTO0,LGOLI0,LGOPO0,LGOST0,LGO *LP0 INTEGER MODUL0(200),MODUM0(200),ERROR0(200),TLITC0(256),TLITE0 INTEGER CURLA0,BRACE0,INDEN0,FIRST0,SPNUM0,LASTN0,CODEL0 INTEGER PROFD0 INTEGER A$BUF(200) COMMON /MISCOM/MODUL0,CURLA0,BRACE0,INDEN0,MODUM0,FIRST0,PROFD0,SP *NUM0,ERROR0,A$BUF,LASTN0,CODEL0,TLITC0,TLITE0 INTEGER AAAAI0(6) INTEGER AAAAJ0(3) INTEGER AAAAK0(6) DATA AAAAI0/196,193,212,193,160,0/ DATA AAAAJ0/169,175,0/ DATA AAAAK0/196,193,212,193,160,0/ IF((A$BUF(246-225+1).EQ.0))GOTO 10043 CALL OUTTAB(2) CALL OUTSTR(AAAAI0,2) CALL OUTSTR(VAR,2) CALL OUTCH(168,2) CALL OUTNUM(INDEX,2) CALL OUTSTR(AAAAJ0,2) CALL OUTNUM(VALUE,2) CALL OUTCH(175,2) CALL OUTDON(2) GOTO 10044 10043 IF((INDEX.NE.1))GOTO 10045 CALL OUTTAB(2) CALL OUTSTR(AAAAK0,2) CALL OUTSTR(VAR,2) CALL OUTCH(175,2) GOTO 10046 10045 CALL OUTCH(172,2) 10046 CALL OUTNUM(VALUE,2) 10044 RETURN END SUBROUTINE GENDA0 INTEGER SYMTE0(200),SYMLO0(200),LASTV0(200) INTEGER SYMLE0,SYMBO0 INTEGER IDTAB0,UNAME0 COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0,LASTV0 INTEGER INBUF0(505) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER LOOPS0,NEXTL0(10),BREAL0(10) COMMON /LOOPC0/LOOPS0,NEXTL0,BREAL0 INTEGER OUTBU0(128,4) INTEGER OUTPA0(4) COMMON /OBUFC0/OUTBU0,OUTPA0 INTEGER MEMAA0(32767) COMMON /DS$MEM/MEMAA0 INTEGER OUTFI0(4),FORTF0 COMMON /OUTFIL/OUTFI0,FORTF0 INTEGER EXPRU0(20),EXPRV0,FALSE0 COMMON /CODEG0/EXPRU0,EXPRV0,FALSE0 INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10) COMMON /SELGEN/SCVAL0,SCLAB0,SLTAA0,RESUL0 INTEGER SCOPE0 INTEGER SCOPF0(100),PROCH0,PROCT0 COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0 INTEGER DISPA0,LASTD0,XGOFR0(407),XGOTO0(407),LGOLI0(1000),LGOPO0( *1000),LGOST0(1000),LGOLP0 COMMON /GOCOM/DISPA0,LASTD0,XGOFR0,XGOTO0,LGOLI0,LGOPO0,LGOST0,LGO *LP0 INTEGER MODUL0(200),MODUM0(200),ERROR0(200),TLITC0(256),TLITE0 INTEGER CURLA0,BRACE0,INDEN0,FIRST0,SPNUM0,LASTN0,CODEL0 INTEGER PROFD0 INTEGER A$BUF(200) COMMON /MISCOM/MODUL0,CURLA0,BRACE0,INDEN0,MODUM0,FIRST0,PROFD0,SP *NUM0,ERROR0,A$BUF,LASTN0,CODEL0,TLITC0,TLITE0 IF((A$BUF(246-225+1).NE.0))GOTO 10047 CALL OUTCH(175,2) CALL OUTDON(2) 10047 RETURN END SUBROUTINE GENIN0(VAR,SUB) INTEGER VAR(1) INTEGER SUB INTEGER AAAAL0(9) DATA AAAAL0/201,206,212,197,199,197,210,160,0/ CALL OUTTAB(1) CALL OUTSTR(AAAAL0,1) CALL OUTSTR(VAR,1) IF((SUB.LE.0))GOTO 10048 CALL OUTCH(168,1) CALL OUTNUM(SUB,1) CALL OUTCH(169,1) 10048 CALL OUTDON(1) RETURN END INTEGER FUNCTION TLIT(C) INTEGER C INTEGER SYMTE0(200),SYMLO0(200),LASTV0(200) INTEGER SYMLE0,SYMBO0 INTEGER IDTAB0,UNAME0 COMMON /LEXCOM/SYMTE0,SYMLE0,SYMBO0,IDTAB0,UNAME0,SYMLO0,LASTV0 INTEGER INBUF0(505) INTEGER IBPAA0,LINEN0(5),LEVEL0 INTEGER INFIL0(5) COMMON /INCOM/INBUF0,IBPAA0,LINEN0,INFIL0,LEVEL0 INTEGER LOOPS0,NEXTL0(10),BREAL0(10) COMMON /LOOPC0/LOOPS0,NEXTL0,BREAL0 INTEGER OUTBU0(128,4) INTEGER OUTPA0(4) COMMON /OBUFC0/OUTBU0,OUTPA0 INTEGER MEMAA0(32767) COMMON /DS$MEM/MEMAA0 INTEGER OUTFI0(4),FORTF0 COMMON /OUTFIL/OUTFI0,FORTF0 INTEGER EXPRU0(20),EXPRV0,FALSE0 COMMON /CODEG0/EXPRU0,EXPRV0,FALSE0 INTEGER SCVAL0(256),SCLAB0(256),SLTAA0,RESUL0(10) COMMON /SELGEN/SCVAL0,SCLAB0,SLTAA0,RESUL0 INTEGER SCOPE0 INTEGER SCOPF0(100),PROCH0,PROCT0 COMMON /PRCCOM/SCOPE0,SCOPF0,PROCH0,PROCT0 INTEGER DISPA0,LASTD0,XGOFR0(407),XGOTO0(407),LGOLI0(1000),LGOPO0( *1000),LGOST0(1000),LGOLP0 COMMON /GOCOM/DISPA0,LASTD0,XGOFR0,XGOTO0,LGOLI0,LGOPO0,LGOST0,LGO *LP0 INTEGER MODUL0(200),MODUM0(200),ERROR0(200),TLITC0(256),TLITE0 INTEGER CURLA0,BRACE0,INDEN0,FIRST0,SPNUM0,LASTN0,CODEL0 INTEGER PROFD0 INTEGER A$BUF(200) COMMON /MISCOM/MODUL0,CURLA0,BRACE0,INDEN0,MODUM0,FIRST0,PROFD0,SP *NUM0,ERROR0,A$BUF,LASTN0,CODEL0,TLITC0,TLITE0 IF((C.NE.0))GOTO 10049 TLIT=TLITE0 RETURN 10049 IF((C.LT.0))GOTO 10051 IF((C.GE.256))GOTO 10051 GOTO 10050 10051 TLIT=0 RETURN 10050 TLIT=TLITC0(C+1) RETURN END C ---- Long Name Map ---- C boolterm boolt0 C callstmt calls0 C casestmt cases0 C returnstmt retus0 C Xgofrom xgofr0 C booloperand boolo0 C collectbalancedstring collf0 C dataother datao0 C deleteunderscores delet0 C enterdefinition enter0 C codeother codeo0 C endmodule endmo0 C enterlongname entet0 C forstmt forst0 C Fortfile fortf0 C Tlitchar tlitc0 C Tliteos tlite0 C Indent inden0 C message messa0 C Slt sltaa0 C otherstmt other0 C cleanup clean0 C convertstringconstant conve0 C putbackstr putbc0 C simpleboolexpr simpl0 C Breaklab breal0 C boolexpr boole0 C generateexprcode gener0 C putback putba0 C Xgoto xgoto0 C Lgostmt lgost0 C copylefthandside copyl0 C genchardata gench0 C maketreenode maket0 C obufcom obufc0 C genprocentry genpt0 C invokemacro invok0 C linkagedecl linka0 C setupprochead setuq0 C Dispatchflag dispa0 C Spnum spnum0 C Codelinenum codel0 C genintdecl genin0 C selectstmt selec0 C checklastforboolean check0 C loadtranstable loadt0 C repeatstmt repea0 C Proctable proct0 C Lastdispatchflag lastd0 C begindecl begin0 C refillbuffer refil0 C exprstackpop exprs0 C strtabledecl strta0 C equivother equiv0 C stopmodule stopm0 C strdecl strde0 C returnmodule retur0 C genproccontroldecl genps0 C beginstmt begip0 C breakstmt break0 C genparam genpa0 C savemodulename savem0 C genprocgoto genpu0 C genselectcode gense0 C includedecl inclu0 C listlongnames listl0 C localdecl local0 C Lgoline lgoli0 C Lgopos lgopo0 C Outbuf outbu0 C Firststmt first0 C Symbol symbo0 C Inbuf inbuf0 C Ibp ibpaa0 C compoundstmt compo0 C genexpr genex0 C loopcom loopc0 C ratforcode ratfo0 C replacetreenode repla0 C Unametable uname0 C Nextlab nextl0 C enddecl endde0 C fatalerr fatal0 C Symlen symle0 C Prochead proch0 C boolfactor boolf0 C exitscope exits0 C gendataitem gendb0 C parboolexpr parbo0 C propagatenots propa0 C removedefinition remov0 C statement state0 C Symlongtext symlo0 C Level level0 C Mem memaa0 C dgetsym dgets0 C gettranschar gettr0 C Falsebranch false0 C Scopetable scopf0 C Profdictfile profd0 C boolprimary boolp0 C Symtext symte0 C Scvalue scval0 C declaration decla0 C endprogram endpr0 C enteroperator enteu0 C gotostmt gotos0 C process procg0 C Loopsp loops0 C codegen codeg0 C enterkw entes0 C setuplocalid setup0 C Modulelongname modum0 C enterprocparam entev0 C proceduredecl proce0 C Result resul0 C Bracecount brace0 C initialize initi0 C restoresym resto0 C skipwhitespace skipw0 C Exprstackptr exprv0 C Lgolp lgolp0 C Modulename modul0 C genproccall genpr0 C genprocreturn genpv0 C getactualparameters getac0 C Outp outpa0 C Outfile outfi0 C beginmodule begio0 C Infile infil0 C makeunique makeu0 C nextstmt nexts0 C collectactualparameter colle0 C gendataend genda0 C negatechildren negat0 C outgolab outgo0 C procedurestmt procf0 C Curlab curla0 C genselgoto gensf0 C Exprstack expru0 C copytreenode copyt0 C enterscope entew0 C savesym saves0 C whilestmt while0 C Lastvar lastv0 C Scopesp scope0 C uniquename uniqu0 C createprocscope creat0 C escapestmt escap0 C getdefinition getde0 C exprstackpush exprt0 C getformalparameters getfo0 C getlongname getlo0 C putbacknum putbb0 C setupwhen setur0 C cleanupgotos cleao0 C Idtable idtab0 C declother declo0 C stopstmt stops0 C Linenumber linen0 C Sclabel sclab0 C Errorsym error0 C Lastnumout lastn0