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,INFD,OUTFD,ARGST0,STATE(4) INTEGER GETARG,OPEN,CREATE,GFNARG,LENGTH,MAPDN INTEGER INF(128),OUTF(128) INTEGER PARSCL INTEGER AAAAA0(39) INTEGER AAAAB0(19) INTEGER AAAAC0(9) INTEGER AAAAD0(13) INTEGER AAAAE0(3) DATA AAAAA0/173,225,226,227,228,229,230,231,232,236,237,240,243,24 *4,246,249,160,173,239,188,242,243,190,160,173,238,188,233,231,238, *190,160,173,248,188,242,243,190,0/ DATA AAAAB0/189,233,238,227,236,189,175,243,247,244,223,228,229,23 *0,174,242,174,233,0/ DATA AAAAC0/233,238,227,236,245,228,229,160,0/ DATA AAAAD0/175,228,229,246,175,243,244,228,239,245,244,177,0/ DATA AAAAE0/174,230,0/ IF((PARSCL(AAAAA0,A$BUF).NE.-3))GOTO 10000 CALL ERROR('Usage: rp [-abcdefghlmpstvy] [-o ] [-x ] {}.') 10000 CALL INITI0 IF((A$BUF(230-225+1).NE.0))GOTO 10001 CALL PUTBA0(138) CALL PUTBA0(167) CALL PUTBC0(AAAAB0) CALL PUTBA0(167) CALL PUTBC0(AAAAC0) 10001 ARGST0=GETARG(1,OUTF,128) IF((A$BUF(239-225+1).EQ.0))GOTO 10002 CALL CTOC(A$BUF(A$BUF(239-225+27)),OUTF,128) GOTO 10003 10002 IF((ARGST0.EQ.-1))GOTO 10005 IF((OUTF(1).EQ.173))GOTO 10005 GOTO 10004 10005 CALL CTOC(AAAAD0,OUTF,128) GOTO 10006 10004 I=LENGTH(OUTF) 10007 IF((I.LT.1))GOTO 10008 IF((OUTF(I).EQ.175))GOTO 10008 I=I-(1) GOTO 10007 10008 J=I+1 GOTO 10011 10009 J=J+(1) 10011 IF((J.GE.I+31))GOTO 10010 IF((OUTF(J).EQ.0))GOTO 10010 IF((((OUTF(J).NE.174).OR.(MAPDN(OUTF(J+1)).NE.242)).OR.(OUTF *(J+2).NE.0)))GOTO 10009 GOTO 10010 10010 CALL SCOPY(AAAAE0,1,OUTF,J) 10006 CONTINUE 10003 OUTFD=CREATE(OUTF,2) IF((OUTFD.NE.-3))GOTO 10013 CALL CLEAN0 CALL CANT(OUTF) 10013 STATE(1)=1 10014 IF((GFNARG(INF,STATE).EQ.-1))GOTO 10015 INFD=OPEN(INF,1) IF((INFD.NE.-3))GOTO 10016 CALL PRINT(-15,'*s: can''t open*n.',INF) GOTO 10014 10016 CALL PROCG0(INFD,OUTFD) CALL CLOSE(INFD) 10017 GOTO 10014 10015 CALL ENDPR0 IF((FIRST0.NE.1))GOTO 10018 CALL SYNERR('Missing ''end'' statement.') 10018 IF((A$BUF(228-225+1).NE.0))GOTO 10019 CALL LISTL0(OUTFD) 10019 CALL CLEAN0 CALL CLOSE(OUTFD) CALL SWT END SUBROUTINE PROCG0(FIN,FOUT) INTEGER FIN,FOUT 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 STATE LEVEL0=1 INFIL0(LEVEL0)=FIN LINEN0(LEVEL0)=0 FORTF0=FOUT OUTFI0(1)=FOUT CALL GETSYM 10020 CONTINUE 10021 IF((SYMBO0.NE.253))GOTO 10022 CALL SYNERR('Unmatched }.') CALL GETSYM GOTO 10021 10022 CALL RATFO0(STATE) IF((STATE.NE.2))GOTO 10023 CALL SYNERR('PARSER FAILURE -- HELP!!.') 10023 CONTINUE IF((SYMBO0.NE.-1))GOTO 10020 RETURN END SUBROUTINE LISTL0(FD) INTEGER FD 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 SCTABL INTEGER POSN INTEGER LNAME(200) INTEGER INFO(3) INTEGER AAAAF0(28) INTEGER AAAAG0(12) DATA AAAAF0/195,160,173,173,173,173,160,204,239,238,231,160,206,22 *5,237,229,160,205,225,240,160,173,173,173,173,170,238,0/ DATA AAAAG0/195,160,170,179,176,243,160,170,243,170,238,0/ CALL PRINT(FD,AAAAF0) POSN=0 10024 IF((SCTABL(IDTAB0,LNAME,INFO,POSN).EQ.-1))GOTO 10025 IF((INFO(1).EQ.2))GOTO 10026 GOTO 10024 10026 CALL PRINT(FD,AAAAG0,LNAME,MEMAA0(INFO(3))) GOTO 10024 10025 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 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 argstatus argst0 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