SUBROUTINE OUTTAB(STREAM) INTEGER STREAM 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,OP,LIM IF((OUTPA0(STREAM).GE.6))GOTO 10000 OP=OUTPA0(STREAM) 10001 IF((OP.GE.6))GOTO 10002 OP=OP+(1) OUTBU0(OP,STREAM)=160 GOTO 10001 10002 IF((STREAM.NE.3))GOTO 10003 IF((INDEN0.GT.20))GOTO 10004 LIM=INDEN0 GOTO 10005 10004 LIM=20 10005 I=1 GOTO 10008 10006 I=I+(1) 10008 IF((I.GT.LIM))GOTO 10007 OP=OP+(2) OUTBU0(OP-1,STREAM)=160 OUTBU0(OP,STREAM)=160 GOTO 10006 10007 CONTINUE 10003 OUTPA0(STREAM)=OP 10000 RETURN END SUBROUTINE OUTCH(C,STREAM) INTEGER C INTEGER STREAM 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 IF((OUTPA0(STREAM).GE.72))GOTO 10009 OUTPA0(STREAM)=OUTPA0(STREAM)+(1) OUTBU0(OUTPA0(STREAM),STREAM)=C GOTO 10010 10009 CALL OUTDON(STREAM) DO 10011 I=1,5 OUTBU0(I,STREAM)=160 10011 CONTINUE 10012 OUTBU0(6,STREAM)=170 OUTBU0(7,STREAM)=C OUTPA0(STREAM)=7 10010 RETURN END SUBROUTINE OUTSTR(STR,STREAM) INTEGER STR(1) INTEGER STREAM 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,K INTEGER C I=1 GOTO 10015 10013 I=I+(1) 10015 IF((STR(I).EQ.0))GOTO 10014 C=STR(I) IF((225.GT.C))GOTO 10016 IF((C.GT.250))GOTO 10016 C=C-225+193 10016 IF((OUTPA0(STREAM).GE.72))GOTO 10017 OUTPA0(STREAM)=OUTPA0(STREAM)+(1) OUTBU0(OUTPA0(STREAM),STREAM)=C GOTO 10013 10017 CALL OUTDON(STREAM) DO 10019 K=1,5 OUTBU0(K,STREAM)=160 10019 CONTINUE 10020 OUTBU0(6,STREAM)=170 OUTBU0(7,STREAM)=C OUTPA0(STREAM)=7 10018 GOTO 10013 10014 RETURN END SUBROUTINE OUTDON(STREAM) INTEGER STREAM 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 OP,I INTEGER BLANKS(73) DATA BLANKS/72*160,0/ OP=OUTPA0(STREAM) IF((OP.EQ.0))GOTO 10021 IF((STREAM.NE.3))GOTO 10022 CODEL0=CODEL0+(1) 10022 IF((A$BUF(236-225+1).EQ.0))GOTO 10023 OUTBU0(OP+1,STREAM)=0 CALL PUTLIN(OUTBU0(1,STREAM),OUTFI0(STREAM)) CALL PUTLIN(BLANKS(OP+1),OUTFI0(STREAM)) I=1 GOTO 10026 10024 I=I+(1) 10026 IF((I.GE.LEVEL0))GOTO 10025 CALL PRINT(OUTFI0(STREAM),'*i,.',LINEN0(I)) GOTO 10024 10025 CALL PRINT(OUTFI0(STREAM),'*i*n.',LINEN0(I)) GOTO 10027 10023 OUTBU0(OP+1,STREAM)=138 OUTBU0(OP+2,STREAM)=0 CALL PUTLIN(OUTBU0(1,STREAM),OUTFI0(STREAM)) 10027 OUTPA0(STREAM)=0 10021 RETURN END SUBROUTINE OUTGO(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 INTEGER I,J,M INTEGER LABGEN,CTOI INTEGER AAAAA0 INTEGER AAAAB0(6) DATA AAAAB0/199,207,212,207,160,0/ M=0 IF((OUTPA0(3).LE.0))GOTO 10029 I=1 M=CTOI(OUTBU0(1,3),I) 10029 IF((A$BUF(231-225+1).EQ.0))GOTO 10030 IF((M.LT.10000))GOTO 10030 IF((LASTD0.NE.1))GOTO 10030 GOTO 10033 10031 OUTPA0(3)=OUTPA0(3)-(1) 10033 IF((OUTPA0(3).LE.0))GOTO 10032 OUTBU0(OUTPA0(3),3)=160 GOTO 10031 10032 IF((N.NE.0))GOTO 10034 N=LABGEN(1) 10034 AAAAA0=1 GOTO 10028 10030 IF((DISPA0.NE.0))GOTO 10037 CALL OUTTAB(3) CALL OUTSTR(AAAAB0,3) IF((N.NE.0))GOTO 10038 N=LABGEN(1) 10038 IF((A$BUF(231-225+1).EQ.0))GOTO 10039 IF((M.LT.10000))GOTO 10039 AAAAA0=2 GOTO 10028 10040 CONTINUE 10039 CALL OUTGO0(N) CALL OUTDON(3) 10037 CONTINUE 10036 DISPA0=1 RETURN 10028 I=MOD(M,407)+1 J=1 GOTO 10043 10041 J=J+(1) 10043 IF((J.GT.407))GOTO 10042 IF((XGOFR0(I).EQ.0))GOTO 10042 IF((I.LT.407))GOTO 10044 I=1 GOTO 10041 10044 I=I+(1) 10045 GOTO 10041 10042 IF((XGOFR0(I).EQ.0))GOTO 10046 CALL FATAL0('No more room in GOTO hash table -- leave off ''-g'' * opt') 10046 XGOFR0(I)=M XGOTO0(I)=N GOTO 10047 10047 GOTO(10036,10040),AAAAA0 GOTO 10047 END SUBROUTINE OUTNUM(N,STREAM) INTEGER N,STREAM 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 CHARS(128) INTEGER LEN INTEGER ITOC INTEGER AAAAC0(9) DATA AAAAC0/195,207,206,212,201,206,213,197,0/ IF(((0.GE.OUTPA0(STREAM)).OR.(OUTPA0(STREAM).GT.5)))GOTO 10048 CALL OUTTAB(STREAM) CALL OUTSTR(AAAAC0,STREAM) CALL OUTDON(STREAM) 10048 IF((OUTPA0(STREAM).NE.0))GOTO 10049 IF((N.NE.0))GOTO 10050 RETURN 10050 LASTD0=DISPA0 DISPA0=0 10049 LEN=ITOC(N,CHARS,128) CHARS(LEN+1)=0 CALL OUTSTR(CHARS,STREAM) RETURN END SUBROUTINE OUTGO0(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 INTEGER AAAAD0(6) DATA AAAAD0/160,160,160,160,160,0/ IF((N.LT.10000))GOTO 10051 IF((A$BUF(231-225+1).EQ.0))GOTO 10051 IF((OUTPA0(3).LE.72-5))GOTO 10052 CALL OUTSTR(AAAAD0,3) 10052 IF((LGOLP0.LT.1000))GOTO 10053 CALL FATAL0('No more room in GOTO list -- leave off ''-g'' opt *.') 10053 LGOLI0(LGOLP0)=CODEL0 LGOPO0(LGOLP0)=OUTPA0(3) LGOST0(LGOLP0)=N LGOLP0=LGOLP0+(1) 10051 CALL OUTNUM(N,3) RETURN END SUBROUTINE CLEAO0 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 TP,LN,SN,NSN,I INTEGER BUF(128),STR(10) INTEGER FINDGO,GETLIN LGOLI0(LGOLP0)=32767 TP=1 LN=1 GOTO 10056 10054 LN=LN+(1) 10056 IF((GETLIN(BUF,OUTFI0(3)).EQ.-1))GOTO 10055 IF((LGOLI0(TP).GE.LN))GOTO 10057 CALL FATAL0('Line numbers out of order in GOTO list.') 10057 CONTINUE 10058 IF((LGOLI0(TP).NE.LN))GOTO 10059 SN=LGOST0(TP) I=1 GOTO 10062 10060 I=I+(1) 10062 IF((I.GT.100))GOTO 10061 IF((FINDGO(SN,NSN).NE.1))GOTO 10061 SN=NSN GOTO 10060 10061 IF((I.LE.100))GOTO 10063 CALL FATAL0('Circular GOTO chain.') 10063 CALL ITOC(SN,STR,10) DO 10064 I=1,5 BUF(LGOPO0(TP)+I)=STR(I) 10064 CONTINUE 10065 TP=TP+(1) GOTO 10058 10059 CALL PUTLIN(BUF,FORTF0) GOTO 10054 10055 LGOLP0=1 DO 10066 I=1,407 XGOFR0(I)=0 10066 CONTINUE 10067 CODEL0=1 RETURN END INTEGER FUNCTION FINDGO(F,T) INTEGER F,T 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,J I=MOD(F,407)+1 J=1 GOTO 10070 10068 J=J+(1) 10070 IF((XGOFR0(I).EQ.F))GOTO 10069 IF((J.GT.407))GOTO 10069 IF((I.LT.407))GOTO 10071 I=1 GOTO 10068 10071 I=I+(1) 10072 GOTO 10068 10069 IF((XGOFR0(I).EQ.F))GOTO 10073 FINDGO=0 RETURN 10073 T=XGOTO0(I) FINDGO=1 RETURN END SUBROUTINE OUTLIT(LITER0,LENGTH,STREAM) INTEGER LENGTH,I INTEGER LITER0(1) INTEGER STREAM 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(232-225+1).EQ.0))GOTO 10074 CALL OUTNUM(LENGTH,STREAM) CALL OUTCH(200,STREAM) I=1 GOTO 10077 10075 I=I+(1) 10077 IF((I.GT.LENGTH))GOTO 10078 CALL OUTCH(LITER0(I),STREAM) GOTO 10075 10074 CALL OUTCH(167,STREAM) I=1 GOTO 10081 10079 I=I+(1) 10081 IF((I.GT.LENGTH))GOTO 10080 IF((LITER0(I).NE.167))GOTO 10082 CALL OUTCH(167,STREAM) 10082 CALL OUTCH(LITER0(I),STREAM) GOTO 10079 10080 CALL OUTCH(167,STREAM) 10078 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 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 literal liter0 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 entergo entex0 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 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