#FCOMMON.FOR CHARACTER*25 INP,OUT DATA OUTFIL /1/, INFIL /1/ WRITE(1)' SSS/SUPERSOFT RATFOR TRANSLATOR VER. 4.1.','[0D][0A]','[0D][0A]' CONTINUE;23001 CONTINUE WRITE(1)' INPUT FILE? ' READ(1,101)INP 101 FORMAT(A0) IF(.NOT.(KLEN(INP).EQ.0))GOTO 23004 GOTO 23003 23004 CONTINUE IF(.NOT.(.NOT. IOREAD(5,2,0,INP)))GOTO 23006 INFIL = 5 GOTO 23003 23006 CONTINUE CALL ERROR("BAD INPUT FILE") 23002 GOTO 23001;23003 CONTINUE CONTINUE;23008 CONTINUE WRITE(1)' OUTPUT FILE? ' READ(1,101)OUT IF(.NOT.(KLEN(OUT).EQ.0))GOTO 23011 GOTO 23010 23011 CONTINUE IF(.NOT.(.NOT. IOWRIT(6,2,0,OUT)))GOTO 23013 OUTFIL = 6 GOTO 23010 23013 CONTINUE CALL ERROR("BAD OUTPUT FILE") 23009 GOTO 23008;23010 CONTINUE CALL PARSE IF(.NOT.(INFIL .EQ. 5))GOTO 23015 X = IOCLOS(5) 23015 CONTINUE IF(.NOT.(OUTFIL .EQ. 6))GOTO 23017 X = IOCLOS(6) 23017 CONTINUE IF(.NOT.(ERRCNT.NE.0))GOTO 23019 WRITE(1,100)ERRCNT," ERRORS DETECTED",'[07]' 23019 CONTINUE STOP 100 FORMAT(I4,A0,A1) END SUBROUTINE ADDTO(LSCRAT,GCBUF,I) CHARACTER*1000 LSCRAT,GCBUF,SUBSTG IF(.NOT.(KLEN(LSCRAT)+I .LE. 1000))GOTO 23021 CALL ADDSTG(LSCRAT,SUBSTG(GCBUF,1,I)) GOTO 23022;23021 CONTINUE CALL ERROR("STATEMENT TOO LONG") 23022 CONTINUE GCBUF = SUBSTG(GCBUF,I+1,9999) RETURN END INTEGER FUNCTION BYFILL(BUF,I) #FCOMMON.FOR CHARACTER*1000 BUF BYFILL=I CONTINUE;23023 CONTINUE BYFILL=IVERFY(BUF,BYFILL," [09]") IF(.NOT.(BYFILL.NE.0))GOTO 23026 RETURN 23026 CONTINUE CALL READCD(BUF) IF(.NOT.(EOFL))GOTO 23028 RETURN 23028 CONTINUE BYFILL=1 23024 GOTO 23023;23025 CONTINUE END INTEGER FUNCTION KEYLUK(STR) CHARACTER*80 STR KEYLUK=0 GOTO(1,2,3,4,5,6,7),KLEN(STR) 1 RETURN 2 IF(.NOT.(STR.EQ."IF"))GOTO 23030 KEYLUK=263 RETURN 23030 CONTINUE IF(.NOT.(STR.EQ."DO"))GOTO 23032 KEYLUK=271 23032 CONTINUE RETURN 3 IF(.NOT.(STR.EQ."END"))GOTO 23034 KEYLUK=275 RETURN 23034 CONTINUE IF(.NOT.(STR.EQ."FOR"))GOTO 23036 KEYLUK=265 23036 CONTINUE RETURN 4 IF(.NOT.(STR.EQ."ELSE"))GOTO 23038 KEYLUK=264 RETURN 23038 CONTINUE IF(.NOT.(STR.EQ."NEXT"))GOTO 23040 KEYLUK=268 23040 CONTINUE RETURN 5 IF(.NOT.(STR.EQ."WHILE"))GOTO 23042 KEYLUK=266 RETURN 23042 CONTINUE IF(.NOT.(STR.EQ."UNTIL"))GOTO 23044 KEYLUK=270 RETURN 23044 CONTINUE IF(.NOT.(STR.EQ."BREAK"))GOTO 23046 KEYLUK=267 23046 CONTINUE RETURN 6 IF(.NOT.(STR.EQ."REPEAT"))GOTO 23048 KEYLUK=269 RETURN 23048 CONTINUE IF(.NOT.(STR.EQ."DEFINE"))GOTO 23050 KEYLUK=273 23050 CONTINUE RETURN 7 IF(.NOT.(STR.EQ."INCLUDE"))GOTO 23052 KEYLUK=274 23052 CONTINUE RETURN END CHARACTER*1000 FUNCTION LOOKUP(STRING) #FCOMMON.FOR CHARACTER*20 STRING,SUBSTG CHARACTER*22 ASTRNG CALL SETLEN(DTEXT,LDTEXT) CALL SETLEN(DNAMES,LDNAMS) CALL CONCAT(ASTRNG,",",STRING,",") I=INDEX(ASTRNG,DNAMES,1) IF(.NOT.(I.LE.0 .OR. I.GE.KLEN(DNAMES)))GOTO 23054 LOOKUP=STRING RETURN 23054 CONTINUE I=KLEN(ASTRNG)+I ASTRNG=SUBSTG(DNAMES,I,I+5) READ (ASTRNG,100)I,J 100 FORMAT(2I3) LOOKUP=SUBSTG(DTEXT,I,J) RETURN END SUBROUTINE PARSE #FCOMMON.FOR CHARACTER*80 LEXSTR INTEGER LEXTYP(100), LABVAL(100) LOGICAL NEED DATA SP/1/, LEXTYP(1)/-1/, NEED/.TRUE./ CONTINUE;23056 CONTINUE IF(.NOT.(NEED))GOTO 23059 TOKEN = LEX(LEXSTR) GOTO 23060;23059 CONTINUE NEED = .TRUE. 23060 CONTINUE CONTINUE;23061 CONTINUE GOTO (262,263,264,265,266,99,99,269,99,271), 1 TOKEN-262+1 99 GOTO 23063 263 CALL IFCODE(LAB) GOTO 23063 271 CALL DOCODE(LAB) GOTO 23063 266 CALL WHILEC(LAB) GOTO 23063 265 CALL FORCOD(LAB) GOTO 23063 269 CALL REPCOD(LAB) GOTO 23063 262 WRITE(OUTFIL)LEXSTR,' ' GOTO 23063 264 IF(.NOT.( LEXTYP(SP) .EQ. 263 ))GOTO 23064 WRITE(OUTFIL,100)'[09]',LABVAL(SP)+1,LABVAL(SP) GOTO 23065;23064 CONTINUE CALL ERROR("ILLEGAL ELSE") 23065 CONTINUE GOTO 23063 23062 GOTO 23061;23063 CONTINUE IF(.NOT.( TOKEN .EQ. 263 .OR. TOKEN .EQ. 264 .OR. TOKEN .EQ. 266 1 .OR. TOKEN .EQ. 265 .OR. TOKEN .EQ. 269 1 .OR. TOKEN .EQ. 271 .OR. TOKEN .EQ. 262 .OR. INT1(TOKEN) .EQ. '[[' ))GOTO 23066 INCREMENT SP IF(.NOT.( SP.GT.100 ))GOTO 23068 CALL ERROR("STACK OVERFLOW IN PARSER") RETURN 23068 CONTINUE LEXTYP(SP) = TOKEN LABVAL(SP) = LAB GOTO 23067;23066 CONTINUE IF(.NOT.( INT1(TOKEN) .EQ. ']' ))GOTO 23070 IF(.NOT.( INT1(LEXTYP(SP)) .EQ. '[[' ))GOTO 23072 DECREMENT SP GOTO 23073;23072 CONTINUE CALL ERROR("ILLEGAL ]") 23073 CONTINUE 23070 CONTINUE CONTINUE;23074 CONTINUE GOTO (267,268,98,98,98,272),TOKEN-267+1 98 GOTO 23076 272 CALL OTHERC(LEXSTR) GOTO 23076 267 CALL EXIT(1) GOTO 23076 268 CALL EXIT(0) GOTO 23076 23075 GOTO 23074;23076 CONTINUE TOKEN = LEX(LEXSTR) NEED = .FALSE. CALL UNSTAK(SP,LEXTYP,LABVAL,TOKEN) 23067 CONTINUE 23057 IF(.NOT.( TOKEN .EQ. -1 ))GOTO 23056;23058 CONTINUE RETURN 100 FORMAT(1X,A1,'GOTO',I6,';',I5,' CONTINUE') END SUBROUTINE UNSTAK(SP,LEXTYP,LABVAL,TOKEN) #FCOMMON.FOR INTEGER LEXTYP(100), LABVAL(100) CONTINUE;23077 IF(.NOT.( SP .GT. 1 ))GOTO 23078 IF(.NOT.( INT1(LEXTYP(SP)) .EQ. '[[' ))GOTO 23079 RETURN 23079 CONTINUE GOTO (262,263,264,265,266,97,97,269,97,271), 1 LEXTYP(SP)-262+1 97 RETURN 263 IF(.NOT.( TOKEN .EQ. 264 ))GOTO 23081 RETURN 23081 CONTINUE WRITE(OUTFIL,100)LABVAL(SP),'[09]' SP = SP - 1 GOTO 23077 264 WRITE(OUTFIL,100)LABVAL(SP-1)+1,'[09]' SP = SP - 2 GOTO 23077 271 CALL DOSTAT(LABVAL(SP)) SP = SP - 1 GOTO 23077 266 CALL WHILES(LABVAL(SP)) SP = SP - 1 GOTO 23077 265 CALL FORS(LABVAL(SP)) SP = SP - 1 GOTO 23077 269 IF(.NOT.( TOKEN .EQ. 270 ))GOTO 23083 CALL UNTILS(LABVAL(SP),1) GOTO 23084;23083 CONTINUE CALL UNTILS(LABVAL(SP),0) 23084 CONTINUE SP = SP - 1 GOTO 23077 262 SP = SP - 1 GOTO 23077 GOTO 23077;23078 CONTINUE RETURN 100 FORMAT(I6,A1,'CONTINUE') END INTEGER FUNCTION LEX(LEXSTR) #FCOMMON.FOR CHARACTER*80 LEXSTR,SUBSTG INTEGER*1 LEX1 DATA LGCBUF /0/ CALL SETLEN(GCBUF,LGCBUF) LEX=-1 CONTINUE;23085 CONTINUE I=BYFILL(GCBUF,1) J = I+1 K = J IF(.NOT.(EOFL))GOTO 23088 RETURN 23088 CONTINUE LEX1 = KHAR(GCBUF,I) LEX=LEX1 IF(.NOT.(LEX1 .EQ. ';' .OR. LEX1 .EQ. '[[' .OR. LEX1 .EQ. ']' ))GOTO 23090 GOTO 23087 23090 CONTINUE K = IVERFY(GCBUF,I,"ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789") IF(.NOT.(K.EQ.0))GOTO 23092 K=9999 23092 CONTINUE IF(.NOT.(K.EQ.I))GOTO 23094 LEX = 272 GOTO 23087 23094 CONTINUE J=K LEXSTR = SUBSTG(GCBUF,I,J-1) IF(.NOT.(IVERFY(LEXSTR,1,"0123456789").EQ.0))GOTO 23096 LEX=262 GOTO 23087 23096 CONTINUE LEX = KEYLUK(LEXSTR) IF(.NOT.(LEX.EQ.0))GOTO 23098 LEX = 272 GOTO 23087 23098 CONTINUE IF(.NOT.(LEX.EQ.275))GOTO 23100 LEX = 272 REASHR = 2 GOTO 23087 23100 CONTINUE GCBUF = SUBSTG(GCBUF,J,9999) LGCBUF=KLEN(GCBUF) IF(.NOT.(LEX.EQ.273))GOTO 23102 CALL DEFST GOTO 23103;23102 CONTINUE IF(.NOT.(LEX.EQ.274))GOTO 23104 CALL INCLST GOTO 23105;23104 CONTINUE RETURN 23105 CONTINUE 23103 CONTINUE CALL SETLEN(GCBUF,LGCBUF) 23086 GOTO 23085;23087 CONTINUE GCBUF = SUBSTG(GCBUF,J,9999) LGCBUF = KLEN(GCBUF) RETURN END SUBROUTINE DEFST #FCOMMON.FOR CHARACTER*20 STR,SUBSTG CHARACTER*22 ASTR INTEGER*1 K1 DATA LDTEXT,LDNAMS/0,0/ CALL SETLEN(DTEXT,LDTEXT) CALL SETLEN(DNAMES,LDNAMS) CALL SETLEN(GCBUF,LGCBUF) I=BYFILL(GCBUF,1) J=IFIND(GCBUF,I," [09]") IF(.NOT.(J.EQ.0))GOTO 23106 J=9999 23106 CONTINUE CALL ADDSTG(DNAMES,",",SUBSTG(GCBUF,I,J-1),",") I=BYFILL(GCBUF,J) DO 23108 J=KLEN(GCBUF),I,-1 K1 = KHAR(GCBUF,J) IF(.NOT.(K1.NE.' ' .AND. K1.NE.'[09]'))GOTO 23110 GOTO 23109 23110 CONTINUE 23108 CONTINUE;23109 CONTINUE K=KLEN(DTEXT)+1 WRITE(ASTR,100)K,K+J-I 100 FORMAT(I4,I3$ CALL ADDSTG(DNAMES,ASTR) LDNAMS=KLEN(DNAMES) CALL ADDSTG(DTEXT,SUBSTG(GCBUF,I,J)) LDTEXT=KLEN(DTEXT) CALL READCD(GCBUF) LGCBUF=KLEN(GCBUF) IF(.NOT.(LDTEXT.GT.1000 .OR. LDNAMS.GT.1000))GOTO 23112 CALL ERROR("DEFINE TABLE SIZE EXCEEDED") 23112 CONTINUE RETURN END SUBROUTINE INCLST #FCOMMON.FOR CHARACTER*25 INCFIL,SUBSTG IF(.NOT.(INFIL.GT.15))GOTO 23114 CALL ERROR("ONLY 3 NESTED INCLUDES ALLOWED") RETURN 23114 CONTINUE CALL SETLEN(GCBUF,LGCBUF) I = BYFILL(GCBUF,1) GCBUF = SUBSTG(GCBUF,I,9999) LGCBUF = KLEN(GCBUF) CALL EATUP(SCRAT) WRITE(INCFIL,100)SCRAT WRITE(1)'INCLUDING FILE: ',SCRAT,'[0D][0A]' IF(.NOT.(IOREAD(INFIL+5,2,0,SUBSTG(INCFIL,1,9999))))GOTO 23116 CALL ERROR("BAD INCLUDE FILE") GOTO 23117;23116 CONTINUE INFIL = INFIL+5 23117 CONTINUE RETURN 100 FORMAT(1X,A0) END SUBROUTINE IFCODE(LAB) #FCOMMON.FOR WRITE(OUTFIL)'[09]','IF(.NOT.' CALL BALPAR(SCRAT,0) LAB = LABGEN(1) WRITE(OUTFIL,100)SCRAT,LAB RETURN 100 FORMAT(1X,A0,')GOTO',I6) END SUBROUTINE WHILEC(LAB) #FCOMMON.FOR LAB = LABGEN(1) CALL PUSH(LAB) WRITE(OUTFIL,100)'[09]',LAB,'[09]' CALL BALPAR(SCRAT,0) WRITE(OUTFIL,200)SCRAT,LAB+1 RETURN 100 FORMAT(1X,A1,'CONTINUE;',I5,A1,'IF(.NOT.'$ 200 FORMAT(1X,A0,')GOTO',I6) END SUBROUTINE WHILES(LAB) #FCOMMON.FOR WRITE(OUTFIL,100)'[09]',LAB,LAB+1 DECREMENT BRKPTR RETURN 100 FORMAT(1X,A1,'GOTO',I6,';',I5,' CONTINUE') END SUBROUTINE OTHERC(LEXSTR) #FCOMMON.FOR CHARACTER*80 LEXSTR DATA REASHR /1/ WRITE(OUTFIL)'[09]',LEXSTR CALL EATUP(SCRAT) WRITE(OUTFIL)SCRAT,'[0D][0A]' GOTO (1,2,3),REASHR 3 WRITE(1)'TRANSLATING ',LEXSTR,SCRAT,'[0D][0A]' REASHR = 1 RETURN 2 REASHR = 3 1 RETURN RETURN END SUBROUTINE REPCOD(LAB) #FCOMMON.FOR LAB = LABGEN(2) WRITE(OUTFIL,100)'[09]',LAB CALL PUSH(LAB+1) RETURN 100 FORMAT(1X,A1,'CONTINUE;',I5,' CONTINUE') END SUBROUTINE UNTILS(LAB,UN) #FCOMMON.FOR IF(.NOT.( UN .GT. 0 ))GOTO 23118 WRITE(OUTFIL,99)LAB+1,'[09]' CALL BALPAR(SCRAT,0) WRITE(OUTFIL,100)SCRAT,LAB,LAB+2 GOTO 23119;23118 CONTINUE WRITE(OUTFIL,101)LAB+1,'[09]',LAB,LAB+2 23119 CONTINUE DECREMENT BRKPTR RETURN 99 FORMAT(I6,A1,'IF(.NOT.'$ 100 FORMAT(1X,A0,')GOTO',I6,';',I5,' CONTINUE') 101 FORMAT(I6,A1,'GOTO',I6,';',I5,' CONTINUE') END SUBROUTINE FORCOD(LAB) #FCOMMON.FOR CHARACTER*80 INITL,TEST,CLAUSE,SUBSTG LAB = LABGEN(2) CALL PUSH(LAB+1) CALL BALPAR(SCRAT,1) IF(.NOT.( SCRAT .EQ. "" ))GOTO 23120 FORLEN(FORPTR) = 0 INCREMENT FORPTR RETURN 23120 CONTINUE CALL PUTCHR(SCRAT,1,' ') INITL=CLAUSE(SCRAT) TEST=CLAUSE(SCRAT) IF(.NOT.(IVERFY(INITL,1," ") .NE. 0 ))GOTO 23122 WRITE(OUTFIL)'[09]',INITL,'[0D][0A]' GOTO 23123;23122 CONTINUE WRITE(OUTFIL)'[09]','CONTINUE','[0D][0A]' 23123 CONTINUE IF(.NOT.( IVERFY(TEST,1," ") .NE.0 ))GOTO 23124 WRITE(OUTFIL,100)LAB,'[09]',TEST,LAB+2 GOTO 23125;23124 CONTINUE WRITE(OUTFIL,101)LAB,'[09]' 23125 CONTINUE JJ = KLEN(SCRAT)-1 FORSTK(FORPTR) = SUBSTG(SCRAT,1,JJ) FORLEN(FORPTR) = JJ INCREMENT FORPTR RETURN 100 FORMAT(I6,A1,'IF (.NOT.(',A0,'))GOTO',I6) 101 FORMAT(I6,A1,'CONTINUE') END CHARACTER*80 FUNCTION CLAUSE(STRING) IMPLICIT INTEGER (A-Z) CHARACTER STRING,CH,SUBSTG I=1 CONTINUE;23126 CONTINUE J = IFIND(STRING,I,"""';") CH = SUBSTG(STRING,J,J) IF(.NOT.(CH .EQ. ";"))GOTO 23129 CLAUSE = SUBSTG(STRING,1,J-1) STRING = SUBSTG(STRING,J+1,9999) RETURN 23129 CONTINUE I = IFIND(STRING,J+1,CH)+1 23127 IF(.NOT.( I .EQ. 1 ))GOTO 23126;23128 CONTINUE CLAUSE = STRING STRING = "" RETURN END SUBROUTINE FORS(LAB) #FCOMMON.FOR DATA FORPTR /1/ DECREMENT BRKPTR DECREMENT FORPTR CALL SETLEN(FORSTK(FORPTR),FORLEN(FORPTR)) IF(.NOT.( IVERFY(FORSTK(FORPTR),1," ") .NE. 0 ))GOTO 23131 WRITE(OUTFIL,100)LAB+1,'[09]',FORSTK(FORPTR) GOTO 23132;23131 CONTINUE WRITE(OUTFIL,101)LAB+1,'[09]' 23132 CONTINUE WRITE(OUTFIL,102)'[09]',LAB,LAB+2 RETURN 100 FORMAT(I6,A1,A0) 101 FORMAT(I6,A1,'CONTINUE') 102 FORMAT(1X,A1,'GOTO',I6,';',I5,' CONTINUE') END SUBROUTINE DOCODE(LAB) #FCOMMON.FOR LAB = LABGEN(1) CALL PUSH(LAB) WRITE(OUTFIL,100)'[09]',LAB CALL EATUP(SCRAT) WRITE(OUTFIL)SCRAT,'[0D][0A]' RETURN 100 FORMAT(1X,A1,'DO',I6$ END SUBROUTINE PUSH(LAB) #FCOMMON.FOR IF(.NOT.(BRKPTR .LT. 10))GOTO 23133 INCREMENT BRKPTR BRKSTK(BRKPTR) = LAB 23133 CONTINUE RETURN END SUBROUTINE DOSTAT(LAB) #FCOMMON.FOR WRITE(OUTFIL,100)LAB,'[09]',LAB+1 DECREMENT BRKPTR RETURN 100 FORMAT(I6,A1,'CONTINUE;',I5,' CONTINUE') END SUBROUTINE EXIT(CODE) #FCOMMON.FOR DATA BRKPTR /0/ IF(.NOT.( BRKPTR .LT. 1 ))GOTO 23135 CALL ERROR("ILLEGAL BREAK OR NEXT") 23135 CONTINUE IF(.NOT.( BRKPTR .GT. 10 ))GOTO 23137 CALL ERROR("BREAK OR NEXT NESTED TOO DEEP") GOTO 23138;23137 CONTINUE WRITE(OUTFIL,100)'[09]',BRKSTK(BRKPTR)+CODE 23138 CONTINUE RETURN 100 FORMAT(1X,A1,'GOTO',I6) END INTEGER FUNCTION LABGEN(EXTRA) INTEGER EXTRA DATA LABEL /23000/ INCREMENT LABEL LABGEN = LABEL LABEL = LABEL+EXTRA RETURN END SUBROUTINE EATUP(LSCRAT) #FCOMMON.FOR CHARACTER*1000 LSCRAT, SUBSTG CHARACTER CH CALL SETLEN(GCBUF,LGCBUF) I = 0 LSCRAT = "" CONTINUE;23139 CONTINUE I = IFIND(GCBUF,I+1,"""';,+-[[]") IF(.NOT.(I.EQ.0))GOTO 23142 I = KLEN(GCBUF) GOTO 23141 23142 CONTINUE CH = SUBSTG(GCBUF,I,I) IF(.NOT.(CH.EQ."""" .OR. CH.EQ."'"))GOTO 23144 I = IFIND(GCBUF,I+1,CH) IF(.NOT.(I.EQ.0))GOTO 23146 CALL ERROR("MISSING QUOTE") K = KLEN(GCBUF) GOTO 23141 23146 CONTINUE GOTO 23140 23144 CONTINUE IF(.NOT.(CH.EQ."[[" .OR. CH.EQ."]" .OR. CH.EQ.";"))GOTO 23148 DECREMENT I GOTO 23141 23148 CONTINUE IF(.NOT.(CH.EQ."," .OR. CH.EQ."+" .OR. CH.EQ."-"))GOTO 23150 IF(.NOT.(IVERFY(GCBUF,I+1," [09]").EQ.0))GOTO 23152 CALL ADDTO(LSCRAT,GCBUF,I+1) WRITE(OUTFIL)LSCRAT,'[0D][0A]' LSCRAT = "[09]1" CALL READCD(GCBUF) I = 0 23152 CONTINUE 23150 CONTINUE 23140 GOTO 23139;23141 CONTINUE CALL ADDTO(LSCRAT,GCBUF,I) LGCBUF = KLEN(GCBUF) RETURN END SUBROUTINE BALPAR(LSCRAT,DOSPLT) #FCOMMON.FOR CHARACTER*1000 LSCRAT CHARACTER SUBSTG,CH CALL SETLEN(GCBUF,LGCBUF) NLPAR = 1 J = 1 LSCRAT="" GCBUF=SUBSTG(GCBUF,IVERFY(GCBUF,1," [09]"),9999) IF(.NOT.(KHAR(GCBUF,1).NE.'('))GOTO 23154 CALL ERROR("MISSING (") GOTO 23155;23154 CONTINUE CONTINUE;23156 CONTINUE IF(.NOT.(EOFL))GOTO 23159 GOTO 23158 23159 CONTINUE J = IFIND(GCBUF,J+1,"()""'[[]") CH = SUBSTG(GCBUF,J,J) IF(.NOT.(J.EQ.0))GOTO 23161 CALL ADDTO(LSCRAT,GCBUF,KLEN(GCBUF)) IF(.NOT.(DOSPLT.EQ.0))GOTO 23163 WRITE(OUTFIL)LSCRAT,'[0D][0A]' LSCRAT = "[09]1" 23163 CONTINUE CALL READCD(GCBUF) GOTO 23162;23161 CONTINUE IF(.NOT.(CH.EQ."("))GOTO 23165 INCREMENT NLPAR GOTO 23166;23165 CONTINUE IF(.NOT.(CH.EQ.")"))GOTO 23167 DECREMENT NLPAR IF(.NOT.(NLPAR.EQ.0))GOTO 23169 GOTO 23158 23169 CONTINUE GOTO 23168;23167 CONTINUE IF(.NOT.(CH.EQ."""" .OR. CH.EQ."'"))GOTO 23171 J = IFIND(GCBUF,J+1,CH) GOTO 23172;23171 CONTINUE CALL ERROR("MISSING )") DECREMENT J GOTO 23158 23172 CONTINUE 23168 CONTINUE 23166 CONTINUE 23162 CONTINUE 23157 GOTO 23156;23158 CONTINUE 23155 CONTINUE CALL ADDTO(LSCRAT,GCBUF,J) LGCBUF = KLEN(GCBUF) RETURN END SUBROUTINE ERROR(IAR) #FCOMMON.FOR CHARACTER*30 IAR DATA ERRCNT /0/ WRITE(OUTFIL,100)IAR INCREMENT ERRCNT RETURN 100 FORMAT('CC ***ERROR*** ',A0) END SUBROUTINE READCD(BUF) #FCOMMON.FOR CHARACTER*80 INBUF,LBUF,BUF,LOOKUP,SUB,SUBSTG DATA EOFL/.FALSE./ BUF = "" IF(.NOT.(EOFL))GOTO 23173 RETURN 23173 CONTINUE CONTINUE;23175 CONTINUE READ(INFIL,100,ENDFILE=200)INBUF IF(.NOT.(KHAR(INBUF,1).NE.'%'))GOTO 23178 GOTO 23177 23178 CONTINUE WRITE(OUTFIL,100)INBUF GOTO 23176 200 IF(.NOT.(INFIL.GT.5))GOTO 23180 X = IOCLOS(INFIL) INFIL = INFIL-5 GOTO 23181;23180 CONTINUE EOFL = .TRUE. RETURN 23181 CONTINUE 23176 GOTO 23175;23177 CONTINUE J = 0 CONTINUE;23182 CONTINUE I = IFIND(INBUF,J+1,"""'<>=!&|[09]#{}") IF(.NOT.(I.EQ.0))GOTO 23185 I=9999 23185 CONTINUE LBUF = SUBSTG(INBUF,J+1,I-1) J = I CONTINUE;23187 CONTINUE L = IFIND(LBUF,1,"ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789") IF(.NOT.(L.EQ.0))GOTO 23190 GOTO 23189 23190 CONTINUE K = IVERFY(LBUF,L,"ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789") IF(.NOT.(K.EQ.0))GOTO 23192 K=9999 23192 CONTINUE CALL ADDSTG(BUF,SUBSTG(LBUF,1,L-1),LOOKUP(SUBSTG(LBUF,L,K-1))) LBUF = SUBSTG(LBUF,K,9999) 23188 GOTO 23187;23189 CONTINUE CALL ADDSTG(BUF,LBUF) GOTO (1,2,2,3,4,5,6,7,8,9,10,11,1),ITABLE("""'<>=!&|[09]{}#",1,KHAR(INBUF,I))+1 1 RETURN 2 J = IFIND(INBUF,I+1,SUBSTG(INBUF,I,I)) IF(.NOT.(J.EQ.0))GOTO 23194 CALL ERROR("MISSING QUOTE") CALL ADDSTG(INBUF,SUBSTG(INBUF,I,I)) J = 9999 23194 CONTINUE CALL ADDSTG(BUF,SUBSTG(INBUF,I,J)) GOTO 23183 3 IF(.NOT.(KHAR(INBUF,I+1) .NE. '='))GOTO 23196 CALL ADDSTG(BUF,".LT.") GOTO 23197;23196 CONTINUE CALL ADDSTG(BUF,".LE.") INCREMENT J 23197 CONTINUE GOTO 23183 4 IF(.NOT.(KHAR(INBUF,I+1) .NE. '='))GOTO 23198 CALL ADDSTG(BUF,".GT.") GOTO 23199;23198 CONTINUE CALL ADDSTG(BUF,".GE.") INCREMENT J 23199 CONTINUE GOTO 23183 5 IF(.NOT.(KHAR(INBUF,I+1) .NE. '='))GOTO 23200 CALL ADDSTG(BUF,"=") GOTO 23201;23200 CONTINUE CALL ADDSTG(BUF,".EQ.") INCREMENT J 23201 CONTINUE GOTO 23183 6 K = IVERFY(INBUF,I+1,"0123456789ABCDEF") IF(.NOT.(KHAR(INBUF,K) .EQ. '!'))GOTO 23202 J=K GOTO 23203;23202 CONTINUE IF(.NOT.(KHAR(INBUF,I+1) .NE. '='))GOTO 23204 CALL ADDSTG(BUF,".NOT.") GOTO 23205;23204 CONTINUE CALL ADDSTG(BUF,".NE.") INCREMENT J 23205 CONTINUE 23203 CONTINUE GOTO 23183 7 IF(.NOT.(KHAR(INBUF,I+1) .EQ. '&'))GOTO 23206 INCREMENT J 23206 CONTINUE CALL ADDSTG(BUF,".AND.") GOTO 23183 8 IF(.NOT.(KHAR(INBUF,I+1) .EQ. '|'))GOTO 23208 INCREMENT J 23208 CONTINUE CALL ADDSTG(BUF,".OR.") GOTO 23183 9 CALL ADDSTG(BUF," ") GOTO 23183 10 CALL ADDSTG(BUF,"[[") GOTO 23183 11 CALL ADDSTG(BUF,"]") 23183 GOTO 23182;23184 CONTINUE 100 FORMAT(A0) END