C FLECS TRANSLATOR (PRELIMINARY VERSION 22.) C (FOR A MORE PRECISE VERSION NUMBER, SEE THE STRING SVER) C C AUTHOR -- TERRY BEYER C C ADDRESS -- COMPUTING CENTER C UNIVERSITY OF OREGON C EUGENE, OREGON 97405 C C TELEPHONE -- (503) 686-4416 C C DATE -- NOVEMBER 20, 1974 C C--------------------------------------- C C DISCLAIMER C C NEITHER THE AUTHOR NOR THE UNIVERSITY OF OREGON SHALL BE C LIABLE FOR ANY DIRECT OR INDIRECT, INCIDENTAL, CONSEQUENTIAL, C OR SPECIFIC DAMAGES OF ANY KIND OR FROM ANY CAUSE WHATSOEVER C ARISING OUT OF OR IN ANY WAY CONNECTED WITH THE USE OR C PERFORMANCE OF THIS PROGRAM. C C--------------------------------------- C C PERMISSION C C THIS PROGRAM IS IN THE PUBLIC DOMAIN AND MAY BE ALTERED C OR REPRODUCED WITHOUT EXPLICIT PERMISSION OF THE AUTHORC C--------------------------------------- C C NOTE TO THE PROGRAMMER WHO WISHES TO ALTER THIS CODE C C C THE PROGRAM BELOW IS THE RESULT OF ABOUT SIX MONTHS OF C RAPID EVOLUTION IN ADDITION TO BEING THE FIRST SUCH C PROGRAM I HAVE EVER WRITTEN. YOU WILL FIND IT IS UNCOMMENTED, C AND IN MANY PLACES OBSCURE. THE LOGIC IS FREQUENTLY C BURIED UNDER A PILE OF PATCHES WHICH BARELY TOLERATE EACH C OTHER S EXISTENCE. C C I PLAN TO WRITE A CLEANER, SMALLER, AND FASTER VERSION OF C THIS PROGRAM WHEN GIVEN THE OPPORTUNITY. IT WAS NEVER C MY INTENT TO PRODUCE A PROGRAM MAINTAINABLE BY ANYONE OTHER C THAN MYSELF ON THIS FIRST PASS. NEVERTHLESS PLEASE C ACCEPT MY APOLOGIES FOR THE CONDITION OF THE CODE BELOW. C I WOULD PREFER IT IF YOU WOULD CONTACT ME AND WAIT FOR C THE NEWER VERSION BEFORE MAKING ANY BUT THE MOST NECESSARY C CHANGES TO THIS PROGRAM. YOU WILL PROBABLY SAVE YOURSELF C MUCH TIME AND GRIEF. C C--------------------------------------- C MODIFIED 7-13-79 BY WILLIAM TANENBAUM C HARVARD UNIVERSITY PHYSICS DEPARTMENT C FOR DIGITAL VAX 11/780 USING CHARACTER DATA TYPE C FACTOR OF 4 TO 5 SPEEDUP IN RUN TIME ACHIEVED C ALSO ALLOWS EXCLAMATION POINT COMMENTS ON FLECS STATEMENTS C ALSO ALLOWS DEBUG LINES FEATURE. C C--------------------------------------------------------------- C C INTEGER DECLARATIONS C C IMPLICIT INTEGER*4(A-Z) C C--------------------------------------- C C LOGICAL DECLARATIONS C C LOGICAL DOFORT, DOLIST, DEBUGG, COMENT, CFIRST, ENDIF LOGICAL BADCH , CONT , DONE , ENDFIL, ENDPGM, ERLST LOGICAL FIRST , FOUND , INDENT, INSERT, INVOKE, MINER LOGICAL NDERR , NIERR , NOPGM , PASS , SAVED C C--------------------------------------- C C ARRAY DECLARATIONS C C C ARRAYS WHICH HOLD RESULTS OF SCANNERS ANALYSIS DIMENSION UTYPE(3), USTART(3), UFIN(3) C C STACK/TABLE AREA AND POINTER TO TOP OF STACK DIMENSION STACK(2000) CHARACTER*8000 CSTAK EQUIVALENCE (STACK,CSTAK) C C SYNTAX ERROR STACK AND TOP POINTER DIMENSION ERRSTK(5) C C--------------------------------------- C C MNEMONIC DECLARATIONS C C C I/O CLASS CODES FOR USE WITH SUBROUTINE PUT DATA LISTCL /2/, ERRCL /3/ C C ACTION CODES FOR USE ON ACTION STACK DATA ACSEQ/1/, AELSE/2/, AFSEQ/3/, ADSEQ/4/, ARSEQ/5/ DATA ATSEQ/6/, AMSEQ/7/, AGRET/8/, ASSEQ/9/ C C TYPE CODES USED BY SCANNERS DATA UEXP/1/, UFORT/2/, UOWSE/3/, UPINV/4/, UDO/5/ C C TYPE CODES OF CHARACTERS (SUPPLIED BY CHTYPE) C WARNING - LOGIC IS SENSITIVE TO THE ORDER OF THESE VALUES. DATA TLETTR/1/, TDIGIT/2/, THYPHN/3/, TLP/4/, TRP/5/ DATA TBLANK/6/, TOTHER/7/, TEOL/8/ C C TYPE CODES ASSIGNED TO THE VARIABLE CLASS DATA TCEXP/1/, TELSE/2/, TEND/3/, TEXEC/4/, TFIN/5/, TTO/6/ C C TYPE CODES ASSIGNED TO THE VARIABLE EXTYPE DATA TCOND/1/, TDO/2/, TFORT/3/, TIF/4/, TINVOK/5/, TRUNTL/6/ DATA TRWHIL/7/, TSELCT/8/, TUNLES/9/, TUNTIL/10/, TWHEN/11/ DATA TWHILE/12/ C C CODES INDICATING SOURCE OF NEXT STATEMENT C IN ANALYZE-NEXT-STATEMENT DATA SETUP /1/, RETRY /2/, READ /3/ C C--------------------------------------- C C C PARAMETERS C C THE FOLLOWING VARIABLES ARE PARAMETERS FOR THE PROGRAM. C THE MEANING OF EACH IS GIVEN BRIEFLY BELOW. FOR MORE INFORMATION C ON THE EFFECT OF THESE PARAMETERS, CONSULT THE SYSTEM MODIFICATION C GUIDE. C C C LISTING WIDTH IN CHARACTERS DATA LWIDTH /132/ C C SIZE OF THE MAIN STACK DATA MAXSTK /2000/ C C NUMBER OF CHARACTERS PER WORD (PER INTEGER) IN A FORMAT DATA NCHPWD /4/ C C SIZE OF HASH TABLE FOR PROCEDURE NAMES - SHOULD BE PRIME. DATA PRIME /53/ C C SAFETY MARGIN BETWEEN TOP AND MAX AT BEGINNING OF EACH LOOP DATA SAFETY /35/ C C SEED FOR GENERATION OF STATEMENT NUMBERS DATA SEEDNO /100000/ C C CHARACTER*1 CH, CHZERO BYTE ICH, ICHZER, CHTYP(0:255) DATA CHTYP/9*7,6,8,21*7,6,7*7,4,5,3*7,3,2*7,10*2,7*7,26*1,6*7, 1 26*1,133*7/ C EQUIVALENCE (CHZERO,ICHZER),(CH,ICH) !TG 4/1/82 EQUIVALENCE (CH,ICH) DATA ICHZER/'0'/ CHARACTER*80 BLANKS DATA BLANKS/' '/ CHARACTER* 5 SBLN CHARACTER*40 SDASH CHARACTER*30 SENDER CHARACTER* 5 SENDIF CHARACTER*53 SGUP1 CHARACTER*44 SGUP2 CHARACTER*54 SICOND CHARACTER*45 SIELSE CHARACTER*44 SIFIN CHARACTER*52 SIFIN2 CHARACTER*45 SIGN CHARACTER*44 SINSRT CHARACTER*51 SINS2 CHARACTER*50 SITODM CHARACTER*39 SIWHEN CHARACTER* 6 SLINE CHARACTER*50 SMULER CHARACTER*42 SNDER1 CHARACTER*44 SNDER2 CHARACTER*46 SNIER1 CHARACTER*44 SNIER2 CHARACTER*37 STABH CHARACTER*21 SVER CHARACTER*54 SXER1 CHARACTER*53 SXER2 CHARACTER*50 SXER3 CHARACTER*40 SXER4 CHARACTER*50 SXER5 CHARACTER*40 SXER6 C COMMON/FILES/DOFORT,DOLIST,DEBUGG C C--------------------------------------- C C STRING DECLARATIONS C C C THE FOLLOWING ARRAYS ARE USED FOR STORAGE OF WORKING STRINGS C AND CORRESPOND TO STRINGS OF THE LENGTHS INDICATED. C THE SIZES GIVEN BELOW ARE EXCESSIVE AND SHOULD BE C BE REDUCED AFTER CAREFUL ANALYSIS (NO TIME NOW). C CHARACTER*80 SCOMN CHARACTER*100 SFLX CHARACTER*100 SHOLD CHARACTER*200 SLIST CHARACTER*80 SPINV CHARACTER*200 SST DATA SSTMAX /200/ C C THE FOLLOWING STRINGS REPRESENT CONSTANTS C DATA SDASH /'----------------------------------------'/ DATA SENDER /'***** END statement is missing.'/ DATA SGUP1 1 /'***** Translator has used up alloted space for tables.'/ DATA SGUP2 /'***** Translation must terminate immediately.'/ DATA SICOND 1 /'***** (CONDITIONAL or SELECT is apparently missing.)'/ DATA SIELSE /'***** (ELSE necessary to match line )'/ DATA SIFIN /'***** (FIN necessary to match line )'/ DATA SIFIN2 1 /'***** (FIN necessary to match line assumed above.)'/ DATA SIGN /'***** (No control phrase for FIN to match.)'/ DATA SINSRT /'***** Statement(s) needed before line )'/ DATA SINS2 1 /'***** Statement(s) needed before line assumed below'/ DATA SITODM 1 /'***** (Only TO and END are valid at this point.)'/ DATA SIWHEN /'***** (WHEN to match following ELSE)'/ DATA SMULER 1 /'***** (Procedure already defined on line )'/ DATA SNDER1 /'***** The next procedures were invoked on'/ DATA SNDER2 /'***** the lines given but were never defined:'/ DATA SNIER1 /'***** The following procedures were defined on'/ DATA SNIER2 /'***** the lines given but were never invoked:'/ DATA STABH /' Procedure Cross-Reference Table'/ DATA SVER /'(FLECS version 22.60)'/ DATA SXER1 1 /'***** (Invalid character in statement number field.)'/ DATA SXER2 1 /'***** (Recognizable statement followed by garbage.)'/ DATA SXER3 1 /'***** (Left paren does not follow control word.)'/ DATA SXER4 /'***** (Too few right parentheses.)'/ DATA SXER5 1 /'***** (Valid procedure name does not follow TO)'/ DATA SXER6 /'***** (Too many right parentheses.)'/ C C--------------------------------------- C C MAIN PROGRAM C PERFORM-INITIALIZATION REPEAT UNTIL (DONE) CALLNO=CALLNO+1 CALL OPENF(CALLNO,DONE,SVER) UNLESS (DONE) ENDFIL=.FALSE. MINCNT=0 MAJCNT=0 LINENO=0 SLINE=' ' REPEAT UNTIL (ENDFIL) PREPARE-TO-PROCESS-PROGRAM PROCESS-PROGRAM FIN CALL CLOSEF(MINCNT,MAJCNT) FIN FIN C RETURN WHEN (MAJCNT.EQ.0) CALL EXIT ELSE CALL SYS$EXIT(%VAL(44)) TO ABORT-ENDIF ENDIF=.FALSE. IND=INDEX(SST(1:LSST),'!') CONDITIONAL (SST(1:5).NE.' ') L=INDEX(SST(1:LSST),'ENDIF') SST(1:LSST+3)=SST(1:L-1)//'CONTINUE'//SST(L+5:LSST+1) LSST=LSST+3 PUT-ENDIF FIN (IND.NE.0) CALL PUTF(SENDIF,SST(IND:LSST)) FIN FIN TO ANALYZE-ERRORS-AND-LIST CONDITIONAL (SOURCE.EQ.SETUP) SOURCE=RETRY (ERROR.EQ.0.AND.ERSTOP.EQ.0) SOURCE=READ LIST-FLEX FIN (OTHERWISE) MINER=(((ERROR.GE.5).AND.(ERROR.LE.6)).OR. 1 ((ERROR.GE.13).AND.(ERROR.LE.15))) MINER=MINER.OR.((ERROR.GE.1).AND.(ERROR.LE.3)) 2 .OR.(ERROR.EQ.25) WHEN (MINER) MINCNT=MINCNT+1 ELSE MAJCNT=MAJCNT+1 WHEN (ERROR.EQ.0) ERTYPE=1 ELSE CONDITIONAL (ERROR.LE.3) INSERT-FIN (ERROR.EQ.4) INSERT-ELSE (ERROR.LE.6) ERTYPE=3 (ERROR.EQ.7) INSERT-ELSE (ERROR.EQ.8) INSERT-WHEN (ERROR.EQ.9) INSERT-TO-DUMMY-PROCEDURE (ERROR.EQ.10) INSERT-WHEN-OR-FIN (ERROR.LE.12) INSERT-FIN (ERROR.LE.15) INSERT-FIN (ERROR.EQ.16) INSERT-ELSE (ERROR.EQ.17) INSERT-CONDITIONAL (ERROR.EQ.18) INSERT-TO-DUMMY-PROCEDURE (ERROR.LE.19) INSERT-CONDITIONAL (ERROR.EQ.20) INSERT-ELSE (ERROR.EQ.21) INSERT-TO-DUMMY-PROCEDURE (ERROR.LE.23) INSERT-FIN (ERROR.EQ.24) INSERT-ELSE (ERROR.EQ.25) ERTYPE=4 (ERROR.EQ.26) ERTYPE=5 FIN FIN SOURCE=READ SELECT (ERTYPE) (1) CALL PUTN(SLINE(2:6),SHOLD(1:LSHOLD),ERRCL) DO (I=1,ERSTOP) SELECT (ERRSTK(I)) (1) CALL PUTZ(SXER1,ERRCL) (2) CALL PUTZ(SXER2,ERRCL) (3) CALL PUTZ(SXER3,ERRCL) (4) CALL PUTZ(SXER4,ERRCL) (5) CALL PUTZ(SXER5,ERRCL) (6) CALL PUTZ(SXER6,ERRCL) FIN FIN FIN (2) SOURCE=SETUP (3) CALL PUTN(SLINE(2:6),SFLX(1:LSFLX),ERRCL) CALL PUTZ(SIGN,ERRCL) FIN (4) CALL PUTZ(SENDER,ERRCL) (5) CALL PUT(SLINE(2:6),SFLX(1:LSFLX),ERRCL) WRITE(SMULER(45:49),'(I5)')MLINE CALL PUTZ(SMULER,ERRCL) FIN FIN FIN FIN IF (ENDPGM) PROCESS-TABLE LIST-BLANK-LINE CALL PUTZ(SVER,LISTCL) FIN FIN TO ANALYZE-NEXT-STATEMENT SELECT (SOURCE) (READ) READ-NEXT-STATEMENT (SETUP) CONTINUE (RETRY) LINENO=HOLDNO WRITE(SLINE,'(I6.5)')LINENO LSFLX=LSHOLD SFLX(1:LSFLX)=SHOLD(1:LSHOLD) FIN FIN ERROR=0 SAVED=.FALSE. NUNITS=0 ERSTOP=0 CURSOR=0 CLASS=0 SCAN-STATEMENT-NUMBER SCAN-CONTINUATION WHEN (CONT.OR.PASS) CLASS=TEXEC EXTYPE=TFORT FIN ELSE SCAN-KEYWORD SELECT (CLASS) (TEXEC) SELECT (EXTYPE) (TFORT) CONTINUE (TINVOK) SCAN-GARBAGE (TCOND) SCAN-GARBAGE (TSELCT) SCAN-CONTROL IF(NUNITS.GT.1) NUNITS=1 CURSOR=USTART(2) RESET-GET-CHARACTER SCAN-GARBAGE FIN FIN (OTHERWISE) SCAN-CONTROL FIN FIN (TFIN) SCAN-GARBAGE (TEND) SCAN-GARBAGE (TELSE) SCAN-PINV-OR-FORT (TTO) CSAVE=CURSOR SCAN-PINV WHEN(FOUND) SCAN-PINV-OR-FORT ELSE ERSTOP=ERSTOP+1 ERRSTK(ERSTOP)=5 SAVE-ORIGINAL-STATEMENT LSFLX=CSAVE+15 SFLX(CSAVE+1:LSFLX)='DUMMY-PROCEDURE' CURSOR=CSAVE RESET-GET-CHARACTER SCAN-PINV FIN FIN (TCEXP) SCAN-CONTROL FIN IF(ERSTOP.GT.0) CLASS=0 LSTLEV=LEVEL FIN TO COMPILE-CEXP WHEN (UTYPE(1).EQ.UEXP) WHEN (CFIRST) IF (ENDIF) PUT-ENDIF CFIRST=.FALSE. LSST=UFIN(1)-USTART(1)+13 SST(1:LSST)=' IF'//SFLX(USTART(1):UFIN(1))//'THEN' FIN ELSE ABORT-ENDIF LSST=UFIN(1)-USTART(1)+17 SST(1:LSST)=' ELSEIF'//SFLX(USTART(1):UFIN(1))//'THEN' FIN FIN ELSE ABORT-ENDIF LSST=10 SST(6:10)=' ELSE' FIN STNO=FLXNO PUT-STATEMENT AXSEQ=AFSEQ COMPLETE-ACTION FIN TO COMPILE-CONDITIONAL IF (ENDIF) PUT-ENDIF PUT-CONTINUE-OR-COMMENT CFIRST=.TRUE. TOP=TOP+2 STACK(TOP)=ACSEQ STACK(TOP-1)=LINENO LEVEL=LEVEL+1 FIN TO COMPILE-DO IF (ENDIF) PUT-ENDIF LSST=UFIN(1)+8-USTART(1) SST(1:LSST)=' DO '//SFLX(USTART(1)+1:UFIN(1)-1) STNO=FLXNO PUT-STATEMENT AXSEQ=ADSEQ COMPLETE-ACTION FIN TO COMPILE-ELSE ABORT-ENDIF TOP=TOP-2 LSST=10 SST(6:10)=' ELSE' STNO=FLXNO PUT-STATEMENT AXSEQ=AFSEQ COMPLETE-ACTION FIN TO COMPILE-END IF (ENDIF) PUT-ENDIF SORT-TABLE PUT-COPY IF (ENDFIL) ERROR=25 ENDPGM=.TRUE. FIN TO COMPILE-EXEC SELECT (EXTYPE) (TFORT) PUT-COPY (TIF) COMPILE-IF (TUNLES) COMPILE-UNLESS (TWHEN) COMPILE-WHEN (TWHILE) COMPILE-WHILE (TUNTIL) COMPILE-UNTIL (TRWHIL) COMPILE-RWHILE (TRUNTL) COMPILE-RUNTIL (TINVOK) COMPILE-INVOKE (TCOND) COMPILE-CONDITIONAL (TSELCT) COMPILE-SELECT (TDO) COMPILE-DO FIN FIN TO COMPILE-FORTRAN IF (ENDIF) PUT-ENDIF LSST=UFIN(2)-USTART(2)+7 SST(6:LSST)=' '//SFLX(USTART(2):UFIN(2)) STNO=FLXNO IND=INDEX(SST(1:LSST),'!') IF (IND.EQ.0) IND=LSST+1 CONDITIONAL (STNO.NE.0) PUT-STATEMENT (SST(7:IND-1).NE.'CONTINUE') PUT-STATEMENT (IND.NE.LSST+1) CALL PUTF(SLINE(2:6),SST(IND:LSST)) FIN FIN TO COMPILE-IF IF (ENDIF) PUT-ENDIF WHEN (NUNITS.EQ.2.AND.UTYPE(2).EQ.UFORT) PUT-COPY ELSE LSST=UFIN(1)-USTART(1)+13 SST(1:LSST)=' IF'//SFLX(USTART(1):UFIN(1))//'THEN' STNO=FLXNO PUT-STATEMENT AXSEQ=AFSEQ COMPLETE-ACTION FIN FIN TO COMPILE-INVOKE IF (ENDIF) PUT-ENDIF FIND-ENTRY CALL PUTF(SLINE(2:6),'C'//BLANKS(1:2*FLEVEL+6)// 1 SFLX(USTART(J):LSFLX)) ENTNO=STACK(PENT+1) RETNO=NEWNO(0) MAX=MAX-2 STACK(MAX+1)=STACK(PENT+3) STACK(PENT+3)=MAX+1 STACK(MAX+2)=LINENO LSST=28 SST(6:13)=' ASSIGN ' SST(19:23)=' TO I' WRITE(SST(14:18),'(I5)')RETNO WRITE(SST(24:28),'(I5)')ENTNO STNO=FLXNO PUT-STATEMENT LSST=17 SST(6:12)=' GO TO ' WRITE(SST(13:17),'(I5)')ENTNO PUT-STATEMENT STNO=RETNO PUT-CONTINUE FIN TO COMPILE-RUNTIL IF (ENDIF) PUT-ENDIF ENTNO=NEWNO(0) SST(1:20)=' IF(.TRUE.)GOTO' WRITE(SST(21:25),'(I5)')ENTNO LSST=25 STNO=FLXNO PUT-STATEMENT LSST=UFIN(1)-USTART(1)+22 SST(6:LSST)=' DO WHILE(.NOT.'//SFLX(USTART(1):UFIN(1))//')' PUT-STATEMENT STNO=ENTNO FLEVEL=FLEVEL+1 PUT-CONTINUE FLEVEL=FLEVEL-1 AXSEQ=ADSEQ COMPLETE-ACTION FIN TO COMPILE-RWHILE IF (ENDIF) PUT-ENDIF ENTNO=NEWNO(0) SST(1:20)=' IF(.TRUE.)GOTO' WRITE(SST(21:25),'(I5)')ENTNO LSST=25 STNO=FLXNO PUT-STATEMENT LSST=UFIN(1)-USTART(1)+15 SST(6:LSST)=' DO WHILE'//SFLX(USTART(1):UFIN(1)) PUT-STATEMENT STNO=ENTNO FLEVEL=FLEVEL+1 PUT-CONTINUE FLEVEL=FLEVEL-1 AXSEQ=ADSEQ COMPLETE-ACTION FIN TO COMPILE-SELECT IF (ENDIF) PUT-ENDIF PUT-CONTINUE-OR-COMMENT CFIRST=.TRUE. L=(UFIN(1)-USTART(1))/NCHPWD+4 TOP=TOP+L+1 WHEN (TOP+SAFETY.LT.MAX) STACK(TOP)=ASSEQ STACK(TOP-1)=LINENO STACK(TOP-2)=L I=TOP-L IP=4*I STACK(I)=UFIN(1)-USTART(1)+1 CSTAK(IP+1:IP+STACK(I))=SFLX(USTART(1):UFIN(1)) FIN ELSE GIVE-UP LEVEL=LEVEL+1 FIN TO COMPILE-SEQ-FIN IF (ENDIF) PUT-ENDIF PUT-CONTINUE-OR-COMMENT STNO=FLXNO IF (STNO.NE.0.) PUT-CONTINUE POP-STACK LEVEL=LEVEL-1 FIN TO COMPILE-SEXP WHEN (UTYPE(1).EQ.UEXP) WHEN (CFIRST) IF (ENDIF) PUT-ENDIF CFIRST=.FALSE. I=TOP-STACK(TOP-2) IP=4*I LSST=UFIN(1)-USTART(1)+STACK(I)+19 SST(1:LSST)=' IF('//SFLX(USTART(1):UFIN(1))// 1 '.EQ.'//CSTAK(IP+1:IP+STACK(I))//')THEN' FIN ELSE ABORT-ENDIF I=TOP-STACK(TOP-2) IP=4*I LSST=UFIN(1)-USTART(1)+STACK(I)+23 SST(1:LSST)=' ELSEIF('//SFLX(USTART(1):UFIN(1))// 1 '.EQ.'//CSTAK(IP+1:IP+STACK(I))//')THEN' FIN FIN ELSE ABORT-ENDIF LSST=10 SST(6:10)=' ELSE' FIN STNO=FLXNO PUT-STATEMENT AXSEQ=AFSEQ COMPLETE-ACTION FIN TO COMPILE-SIMPLE-FIN IF (ENDIF) PUT-ENDIF SELECT (ACTION) (AFSEQ) STNO=FLXNO STORE-ENDIF FIN (ADSEQ) STNO=FLXNO IF (STNO.NE.0) PUT-CONTINUE LSST=11 SST(1:11)=' ENDDO' PUT-STATEMENT FIN (ARSEQ) STNO=FLXNO IF (STNO.NE.0) PUT-CONTINUE FIN FIN FLEVEL=FLEVEL-1 LEVEL=LEVEL-1 TOP=TOP-2 FIN TO COMPILE-TO IF (ENDIF) PUT-ENDIF CALL PUTF(' ','C') CALL PUTF(' ','C'//SDASH) CALL PUTF(' ','C') CALL PUTF(SLINE(2:6),'C '//SFLX(7:LSFLX)) FIND-ENTRY WHEN(STACK(PENT+2).NE.0) ERROR=26 MLINE=STACK(PENT+2) ENTNO=NEWNO(0) FIN ELSE ENTNO=STACK(PENT+1) STACK(PENT+2)=LINENO FIN STNO=FLXNO IF (STNO.NE.0) PUT-CONTINUE STNO=ENTNO PUT-CONTINUE TOP=TOP+2 STACK(TOP)=AGRET STACK(TOP-1)=ENTNO UTYPE(1)=0 AXSEQ=ARSEQ COMPLETE-ACTION FIN TO COMPILE-UNLESS IF (ENDIF) PUT-ENDIF WHEN (NUNITS.EQ.2.AND.UTYPE(2).EQ.UFORT) LSST=+UFIN(1)+UFIN(2)-USTART(1)-USTART(2)+17 SST(6:LSST)=' IF(.NOT.'//SFLX(USTART(1):UFIN(1))// 1 ')'//SFLX(USTART(2):UFIN(2)) STNO=FLXNO PUT-STATEMENT FIN ELSE LSST=UFIN(1)-USTART(1)+20 SST(1:LSST)=' IF(.NOT.'//SFLX(USTART(1):UFIN(1))//')THEN' STNO=FLXNO PUT-STATEMENT AXSEQ=AFSEQ COMPLETE-ACTION FIN FIN TO COMPILE-UNTIL IF (ENDIF) PUT-ENDIF LSST=UFIN(1)-USTART(1)+22 SST(6:LSST)=' DO WHILE(.NOT.'//SFLX(USTART(1):UFIN(1))//')' STNO=FLXNO PUT-STATEMENT AXSEQ=ADSEQ COMPLETE-ACTION FIN TO COMPILE-WHEN IF (ENDIF) PUT-ENDIF TOP=TOP+2 STACK(TOP-1)=LINENO STACK(TOP)=AELSE LSST=UFIN(1)-USTART(1)+13 SST(6:LSST)=' IF'//SFLX(USTART(1):UFIN(1))//'THEN' STNO=FLXNO PUT-STATEMENT AXSEQ=AFSEQ COMPLETE-ACTION FIN TO COMPILE-WHILE IF (ENDIF) PUT-ENDIF LSST=UFIN(1)-USTART(1)+15 SST(6:LSST)=' DO WHILE'//SFLX(USTART(1):UFIN(1)) STNO=FLXNO PUT-STATEMENT AXSEQ=ADSEQ COMPLETE-ACTION FIN TO COMPLETE-ACTION WHEN (NUNITS.EQ.1) PUSH-FINSEQ ELSE FLEVEL=FLEVEL+1 CONDITIONAL (UTYPE(2).EQ.UPINV) COMPILE-INVOKE (SFLX(USTART(2):UFIN(2)).NE.'CONTINUE') COMPILE-FORTRAN FIN SELECT (AXSEQ) (AFSEQ) STNO=0 STORE-ENDIF FIN (ADSEQ) STNO=FLXNO IF (STNO.NE.0) PUT-CONTINUE LSST=11 SST(1:11)=' ENDDO' PUT-STATEMENT FIN FIN FLEVEL=FLEVEL-1 FIN FIN TO FIND-ENTRY WHEN (UTYPE(1).EQ.UPINV) J=1 ELSE J=2 LSPINV=UFIN(J)-USTART(J)+1 SPINV(1:LSPINV)=SFLX(USTART(J):UFIN(J)) WHEN (SPINV(1:LSPINV).EQ.'DUMMY-PROCEDURE') PENT=PDUMMY STACK(PENT+2)=0 FIN ELSE P=MAXSTK-HASH(SPINV(1:LSPINV),PRIME) FOUND=.FALSE. UNLESS(STACK(P).EQ.0) REPEAT UNTIL(STACK(P).EQ.0.OR.FOUND) P=STACK(P) IP=4*(P+4) IF (SPINV(1:LSPINV).EQ.CSTAK(IP+1:IP+STACK(P+4))) FOUND=.TRUE. FIN FIN WHEN (FOUND) PENT=P ELSE TMAX=MAX-(6+(LSPINV+NCHPWD-1)/NCHPWD) WHEN (TMAX.LE.TOP+SAFETY) PENT=PDUMMY STACK(PENT+2)=0 FIN ELSE MAX=TMAX PENT=MAX+2 STACK(PENT)=0 STACK(P)=PENT STACK(PENT+1)=NEWNO(0) STACK(PENT+2)=0 STACK(PENT+3)=0 IP=4*(PENT+4) STACK(PENT+4)=LSPINV CSTAK(IP+1:IP+LSPINV)=SPINV(1:LSPINV) FIN FIN FIN FIN TO GENERATE-RETURN-FROM-PROC LSST=18 SST(6:13)=' GO TO I' WRITE(SST(14:18),'(I5)')STACK(TOP-1) STNO=FLXNO PUT-STATEMENT TOP=TOP-2 FIN C C----------------------------------------------------------------------------- C TO GET-CHARACTER C CURSOR=CURSOR+1 WHEN(CURSOR.GT.LSFLX) CHTYPE=TEOL ELSE CH = SFLX(CURSOR:CURSOR) C CHTYPE = CHTYP(ICH) !TG 4/1/82 CHTYPE = CHTYP(ICHAR(CH)) FIN FIN C C------------------------------------------------------------------------------ C TO GIVE-UP CALL PUTZ(SGUP1,ERRCL) CALL PUTZ(SGUP2,ERRCL) CALL CLOSEF(MINCNT,-1) FIN TO INSERT-CONDITIONAL PREPARE-FOR-INSERTION LSFLX=17 SFLX(1:LSFLX)=' CONDITIONAL' CALL PUTZ(SICOND,ERRCL) FIN TO INSERT-ELSE PREPARE-FOR-INSERTION LSFLX=19 SFLX(1:LSFLX)=' ELSE CONTINUE' WRITE(SIELSE(40:44),'(I5)')STACK(TOP-1) CALL PUTZ(SIELSE,ERRCL) FIN TO INSERT-FIN PREPARE-FOR-INSERTION LSFLX=9 SFLX(1:LSFLX)=' FIN' WHEN (STACK(TOP-1).EQ.0) CALL PUTZ(SIFIN2,ERRCL) ELSE WRITE(SIFIN(39:43),'(I5)')STACK(TOP-1) CALL PUTZ(SIFIN,ERRCL) FIN FIN TO INSERT-TO-DUMMY-PROCEDURE PREPARE-FOR-INSERTION LSFLX=24 SFLX(1:LSFLX)=' TO DUMMY-PROCEDURE' CALL PUTZ(SITODM,ERRCL) FIN TO INSERT-WHEN PREPARE-FOR-INSERTION LSFLX=24 SFLX(1:LSFLX)=' WHEN (.TRUE.) STOP' CALL PUTZ(SIWHEN,ERRCL) FIN TO INSERT-WHEN-OR-FIN CONDITIONAL (TOP.LE.7) INSERT-WHEN (STACK(TOP-6).EQ.AELSE) INSERT-FIN (OTHERWISE) INSERT-WHEN FIN FIN TO LIST-BLANK-LINE LSTLEV=LEVEL LSLIST=3*LSTLEV+6 WHEN (LSTLEV.EQ.0.OR.LSLIST.GT.WWIDTH) CALL PUT(SBLN,' ',LISTCL) ELSE SLIST(1:6)=' ' DO (I=7,LSLIST,3) SLIST(I:I+2)='. ' CALL PUT(SBLN,SLIST(1:LSLIST),LISTCL) FIN SBLN=' ' FIN TO LIST-COMMENT-LINE CURSOR=1 RESET-GET-CHARACTER INDENT=.TRUE. I=2 REPEAT WHILE (I.LE.6.AND.INDENT) GET-CHARACTER IF (CHTYPE.NE.TBLANK.AND.CHTYPE.NE.TEOL) INDENT=.FALSE. I=I+1 FIN WHEN (INDENT) LSTLEV=LEVEL CLASS=0 LIST-FLEX FIN ELSE CALL PUT(SLINE(2:6),SFLX(1:LSFLX),LISTCL) FIN TO LIST-DASHES CALL PUTZ(' ',LISTCL) CALL PUTZ(SDASH,LISTCL) CALL PUTZ(' ',LISTCL) FIN TO LIST-FLEX IF (CLASS.EQ.TTO) LIST-DASHES IF (LSFLX.LT.7) LSFLX=LSFLX+7 SFLX(LSFLX-6:LSFLX)=' ' FIN SLIST(1:6)=SFLX(1:6) LSLIST=6 UNLESS(LSTLEV.EQ.0.OR.(3*LSTLEV+LSFLX.GT.WWIDTH)) DO (I=1,LSTLEV) LSLIST=LSLIST+3 SLIST(LSLIST-2:LSLIST)='. ' FIN IF(CLASS.EQ.TFIN) SLIST(LSLIST-2:LSLIST)='...' FIN I=7 WHILE (SFLX(I:I).EQ.' '.AND.I.LT.LSFLX) I=I+1 LSLIST=LSLIST+LSFLX-I+1 SLIST(LSLIST-LSFLX+I:LSLIST)=SFLX(I:LSFLX) IF (COMENT) COMENT=.FALSE. LSLIST=LSLIST+LSCOMN SLIST(LSLIST-LSCOMN+1:LSLIST)=SCOMN FIN IF ((.NOT. COMENT) .AND.LSCOMN.NE.0) !added 7-30-82 by HARN LSLIST=LSLIST+LSCOMN !(rutgers) to preserve SLIST(LSLIST-LSCOMN+1:LSLIST)=SCOMN !comments after keyword LSCOMN=0 !declaration of multi-line FIN !structure. IF (LSLIST.GT.WWIDTH) !Syntax corrected 11-10-95 LSLIST=LSFLX !by Steve Lionel (Digital) SLIST(1:LSLIST)=SFLX(1:LSFLX) FIN WHEN (ERLST) CALL PUT(SLINE(2:6),SLIST(1:LSLIST),ERRCL) ERLST=.FALSE. FIN ELSE CALL PUT(SLINE(2:6),SLIST(1:LSLIST),LISTCL) FIN TO PERFORM-INITIALIZATION CALLNO=0 SBLN=' ' WWIDTH=LWIDTH-6 REFNO=LWIDTH-15 ERLST=.FALSE. ENDIF=.FALSE. FIN TO POP-STACK TOPTYP=STACK(TOP) SELECT (TOPTYP) (ASSEQ) TOP=TOP-STACK(TOP-2)-1 (ACSEQ) TOP=TOP-2 (ARSEQ) TOP=TOP-2 (ADSEQ) TOP=TOP-2 (AFSEQ) TOP=TOP-2 (AELSE) TOP=TOP-2 (ATSEQ) TOP=TOP-1 (AMSEQ) TOP=TOP-1 (AGRET) TOP=TOP-2 FIN FIN TO PREPARE-FOR-INSERTION ERTYPE=2 SAVE-ORIGINAL-STATEMENT LINENO=0 SLINE=' ' IF (SOURCE.EQ.READ) WHEN (HOLDNO.LE.0) CALL PUTZ(SINS2,ERRCL) ELSE WRITE(SINSRT(39:43),'(I5)')HOLDNO CALL PUTZ(SINSRT,ERRCL) FIN FIN FIN TO PREPARE-TO-PROCESS-PROGRAM DUMMY=NEWNO(SEEDNO) ENDPGM=.FALSE. MAX=MAXSTK-(PRIME+4) PDUMMY=MAX+1 DO (I=MAX,MAXSTK) STACK(I)=0 TOP=1 STACK(TOP)=AMSEQ COMENT=.FALSE. ERROR=0 FIRST=.TRUE. NOPGM=.FALSE. SOURCE=READ LEVEL=0 FLEVEL=0 LSTLEV=0 LIST-DASHES FIN TO PROCESS-PROGRAM REPEAT UNTIL (ENDPGM) IF(TOP+SAFETY.GT.MAX) GIVE-UP ACTION=STACK(TOP) SELECT (ACTION) (AGRET) GENERATE-RETURN-FROM-PROC (OTHERWISE) ANALYZE-NEXT-STATEMENT SELECT (ACTION) (AMSEQ) SELECT(CLASS) (TEXEC) COMPILE-EXEC (TEND) WHEN (NOPGM) ENDPGM=.TRUE. ELSE COMPILE-END FIN (TFIN) ERROR=5 (TELSE) ERROR=8 (TTO) STACK(TOP)=ATSEQ COMPILE-TO FIN (TCEXP) ERROR=17 FIN FIN (ASSEQ) SELECT (CLASS) (TCEXP) COMPILE-SEXP (TFIN) COMPILE-SEQ-FIN (TEND) ERROR=3 (TELSE) ERROR=12 (TTO) ERROR=15 (TEXEC) ERROR=23 FIN FIN (ACSEQ) SELECT(CLASS) (TCEXP) COMPILE-CEXP (TFIN) COMPILE-SEQ-FIN (TEND) ERROR=2 (TELSE) ERROR=11 (TTO) ERROR=14 (TEXEC) ERROR=22 FIN FIN (AELSE) SELECT(CLASS) (TELSE) COMPILE-ELSE (TEND) ERROR=4 (TFIN) ERROR=7 (TTO) ERROR=16 (TCEXP) ERROR=20 (TEXEC) ERROR=24 FIN FIN (ATSEQ) SELECT (CLASS) (TTO) COMPILE-TO (TEND) COMPILE-END (TFIN) ERROR=6 (TELSE) ERROR=9 (TCEXP) ERROR=18 (TEXEC) ERROR=21 FIN FIN (OTHERWISE) SELECT(CLASS) (TEXEC) COMPILE-EXEC (TFIN) COMPILE-SIMPLE-FIN (TEND) ERROR=1 (TELSE) ERROR=10 (TTO) ERROR=13 (TCEXP) ERROR=19 FIN FIN FIN UNLESS (NOPGM) ANALYZE-ERRORS-AND-LIST FIN FIN FIN FIN TO PROCESS-TABLE UNLESS (PTABLE.EQ.0) TABLCL=LISTCL LIST-DASHES CALL PUTZ(STABH,LISTCL) CALL PUTZ(' ',LISTCL) P=PTABLE NDERR=.FALSE. NIERR=.FALSE. REPEAT UNTIL (P.EQ.0) IF (STACK(P+2).EQ.0) NDERR=.TRUE. MAJCNT=MAJCNT+1 FIN IF (STACK(P+3).EQ.0) NIERR=.TRUE. MINCNT=MINCNT+1 FIN PRODUCE-ENTRY-LISTING P=STACK(P) FIN IF (NDERR) CALL PUTZ(SNDER1,ERRCL) CALL PUTZ(SNDER2,ERRCL) LIST-BLANK-LINE P=PTABLE TABLCL=ERRCL REPEAT UNTIL (P.EQ.0) IF (STACK(P+2).EQ.0) PRODUCE-ENTRY-LISTING P=STACK(P) FIN FIN IF (NIERR) CALL PUTZ(SNIER1,ERRCL) CALL PUTZ(SNIER2,ERRCL) LIST-BLANK-LINE P=PTABLE TABLCL=ERRCL REPEAT UNTIL (P.EQ.0) IF(STACK(P+3).EQ.0) PRODUCE-ENTRY-LISTING P=STACK(P) FIN FIN FIN FIN TO PRODUCE-ENTRY-LISTING SST(1:7)=' ' IF (STACK(P+2).NE.0) WRITE(SST(1:6),'(I6.5)')STACK(P+2) IP=4*(P+4) CALL PUTZ(SST(2:7)//CSTAK(IP+1:IP+STACK(P+4)),TABLCL) QP=STACK(P+3) UNTIL (QP.EQ.0) LSST=4 SST(1:4)=' ' UNTIL(QP.EQ.0.OR.LSST.GT.REFNO) LSST=LSST+7 WRITE(SST(LSST-6:LSST),'(I7.5)')STACK(QP+1) QP=STACK(QP) FIN CALL PUTZ(SST(1:LSST),TABLCL) FIN CALL PUTZ(' ',LISTCL) FIN TO PUSH-FINSEQ TOP=TOP+2 STACK(TOP-1)=LINENO STACK(TOP)=AXSEQ LEVEL=LEVEL+1 FLEVEL=FLEVEL+1 FIN TO PUT-CONTINUE LSST=14 SST(6:14)=' CONTINUE' PUT-STATEMENT FIN TO PUT-CONTINUE-OR-COMMENT STNO=FLXNO CONDITIONAL (STNO.NE.0) PUT-CONTINUE (COMENT) COMENT=.FALSE. CALL PUTF(SLINE(2:6),SCOMN(1:LSCOMN)) FIN FIN FIN TO PUT-COPY IF (ENDIF) PUT-ENDIF WHEN (LSFLX.LT.7.OR.PASS) CALL PUTF(SLINE(2:6),SFLX(1:LSFLX)) ELSE CH = SFLX(9:9) C IF (LSFLX.GE.9.AND.SFLX(1:8).EQ.' '.AND.CHTYP(ICH).EQ.TDIGIT) IF (LSFLX.GE.9.AND.SFLX(1:8).EQ.' '.AND.CHTYP(ICHAR(CH)).EQ.TDIGIT) SFLX(6:6) = CH SFLX(9:9) = ' ' FIN I=7 WHILE (SFLX(I:I).EQ.' '.AND.I.LT.LSFLX) I=I+1 LSST=LSFLX+7-I SST(6:6)=SFLX(6:6) SST(7:LSST)=SFLX(I:LSFLX) STNO=FLXNO PUT-STATEMENT FIN FIN TO PUT-ENDIF ENDIF=.FALSE. IND=INDEX(SST(1:LSST),'!') IF (IND.EQ.0) IND=LSST+1 SST(IND:IND)=' ' FIN LSAV=LSST LSST=IND-1 WHEN (LSST.LE.72) WHEN (LSAV.GE.IND)CALL PUTF(SENDIF,SST(1:LSST)//SST(IND:LSAV)) ELSE CALL PUTF(SENDIF,SST(1:LSST)) FIN ELSE WHEN (LSAV.GE.IND)CALL PUTF(SLINE(2:6),SST(1:72)//SST(IND:LSAV)) ELSE CALL PUTF(SLINE(2:6),SST(1:72)) S=73 REPEAT UNTIL (S.GT.LSST) L=S+65 IF (L.GT.LSST) L=LSST CALL PUTF(SENDIF,' 1'//SST(S:L)) S=S+66 FIN FIN FIN TO PUT-STATEMENT IF (ENDIF) PUT-ENDIF IF (COMENT) COMENT=.FALSE. SST(LSST+1:LSST+LSCOMN)=SCOMN(1:LSCOMN) LSST=LSST+LSCOMN FIN WRITE(SST(1:5),'(I5.0)')STNO STNO=0 FLXNO=0 NB=2*FLEVEL SST(LSST+1:LSST+1)='!' I=0 REPEAT UNTIL (SST(I:I).EQ.'!') I=I+1 IF (SST(I:I).EQ.'''')I=INDEX(SST(I+1:LSST+1),'''')+I+1 FIN SST(LSST+1:LSST+1)=' ' LSAV=LSST C IF (LSAV.LT.I) LSAV=I !CLNS LSAV SOMETIMES