INCLUDE FLXHDR.FLX PROGRAM FLECS !FLECS TRANSLATOR MAIN PROGRAM C INTEGER ACSEQ , ACTION, AELSE , AFSEQ , AGCONT, AGGOTO INTEGER AGRET , AGSTNO, AMSEQ , ASSEQ , ATSEQ INTEGER BLN , NOCALL, CHC , CHSPAC, CHZERO INTEGER CLASS , CONTNO, DUMMY , ELSNO , ENDNO , ENTNO INTEGER ERRCL , ERROR , ERRSTK, ERSTOP, EXTYPE, FLXNO INTEGER FORTCL, GGOTON, GOTONO, GSTNO , HASH , HOLDNO INTEGER I , ITEMP , J , L , LEVEL , LINENO INTEGER LL , LP , LR , LT INTEGER LISTCL, LOOPNO, LSTLEV, MAJCNT INTEGER MAX , MAXSTK, MINCNT, MLINE , NCHPWD, NEWNO INTEGER NEXTNO, NUNITS, NXIFNO, OFFSET, OFFST2, P INTEGER PARAM1, PARAM2, PARAM3, PARAM4, PDUMMY, PENT INTEGER PRIME , PTABLE, Q , QM , QP , READ INTEGER REFNO , RETNO , RETRY , S , SAFETY, SASSN1 INTEGER SASSN2, SB , SB5I1 , SB6 , SB6I , SB7 , SBGOTO INTEGER SCONT INTEGER SCOMMA, SCP , SDASH , SDOST , SDUM , SEEDNO, SEQ INTEGER SETUP , SFLX , SFORCE, SGOTO , SGOTOI, SGUP1 INTEGER SGOTOP INTEGER SGUP2 , SHOLD , SIF , SIFP , SIFPN , SLIST INTEGER SNE , SOURCE, SPB , SPGOTO, SPINV , SPUTGO INTEGER SRP , SRTN , SSPACR, SST , SSTMAX, SSTOP INTEGER SRPCI INTEGER STACK , STNO , SVER , TCEXP , TCOND , TDO INTEGER TELSE , TEND , TESTNO, TEXEC , TFIN , TFORT INTEGER TIF , TINVOK, TMAX , TOP , TOPNO , TOPTYP INTEGER TRUNTL, TRWHIL, TSELCT, TTO , TUNLES, TUNTIL INTEGER TWHEN , TWHILE, UDO , UEXP , UFORT , ULEN INTEGER UOWSE , UPINV , USTART, UTYPE , WWIDTH INTEGER CHPERD INTEGER SFSPCR INTEGER EOUT , FOUT , IN , LOUT , LWIDTH, CHTAB INTEGER CHCOMT, CHSYST C LOGICAL COGOTO, FAKE , LONG LOGICAL DONE , ENDFIL, ENDPGM, ERLST , FIRST , FOUND , INSERT LOGICAL NOPGM , NOTFLG, PASS , SAVED , SHORT , STREQ , STRLT LOGICAL NEWVER, FORTOF, LISTOF, CONDOF, RT11 C COMMON BLN , CLASS , DONE , ENDFIL, ENDPGM, ERLST COMMON ERROR , ERRSTK, ERSTOP, EXTYPE, FIRST , FLXNO COMMON FOUND , HOLDNO, LEVEL , LINENO, LSTLEV, MAJCNT COMMON MINCNT, MLINE , NOPGM , NUNITS, PASS , PTABLE, QP COMMON REFNO , SAVED , SFLX , SHOLD , SLIST , SOURCE COMMON SPINV , SPUTGO, SST , STACK , TOP , ULEN COMMON USTART, UTYPE , WWIDTH COMMON SSPACR, SFSPCR, OFFSET, OFFST2 COMMON SHORT , FAKE , LONG , COGOTO COMMON /CONTRL/NEWVER, FORTOF, LISTOF, CONDOF COMMON /SYSTEM/ EOUT , FOUT , IN , LOUT , LWIDTH, CHTAB, + CHCOMT,CHSYST COMMON /VERSON/ SVER C DIMENSION UTYPE (3) DIMENSION USTART (3) DIMENSION ULEN (3) DIMENSION STACK (1500) DIMENSION ERRSTK (5) DIMENSION SFLX (101) DIMENSION SHOLD (101) DIMENSION SLIST (201) DIMENSION SPINV (81) DIMENSION SPUTGO (21) DIMENSION SST (201) DIMENSION SASSN1 (14) DIMENSION SASSN2 (6) DIMENSION SB (2) DIMENSION SB5I1 (7) DIMENSION SB6 (7) DIMENSION SB7 (8) DIMENSION SB6I (8) DIMENSION SBGOTO (8) DIMENSION SCOMMA (2) DIMENSION SCONT (9) DIMENSION SCP (3) DIMENSION SDOST (10) DIMENSION SDASH (41) DIMENSION SDUM (16) DIMENSION SEQ (2) DIMENSION SFORCE (15) DIMENSION SFSPCR (4) DIMENSION SGOTO (13) DIMENSION SGOTOI (14) DIMENSION SGOTOP (14) DIMENSION SGUP1 (54) DIMENSION SGUP2 (45) DIMENSION SIF (9) DIMENSION SIFP (10) DIMENSION SIFPN (15) DIMENSION SNE (5) DIMENSION SPB (3) DIMENSION SPGOTO (9) DIMENSION SRP (2) DIMENSION SRPCI (5) DIMENSION SRTN (13) DIMENSION SSPACR (4) DIMENSION SSTOP (16) DIMENSION SVER (22) C DATA CHPERD /1H./ DATA FORTCL /1/, LISTCL /2/, ERRCL /3/ DATA ACSEQ/1/, AELSE/2/, AFSEQ/3/, AGCONT/4/, AGGOTO/5/ DATA AGSTNO/6/, AMSEQ/7/, AGRET/8/, ASSEQ/9/, ATSEQ/10/ DATA UEXP/1/, UFORT/2/, UOWSE/3/, UPINV/4/, UDO/5/ DATA TCEXP/1/, TELSE/2/, TEND/3/, TEXEC/4/, TFIN/5/, TTO/6/ 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/ DATA SETUP /1/, RETRY /2/, READ /3/ DATA CHC /1HC/ DATA MAXSTK /1500/ DATA PRIME /53/ DATA SAFETY /35/ DATA SEEDNO /32760/ DATA CHSPAC /1H / DATA CHZERO /1H0/ DATA SSTMAX /200/ DATA SASSN1(1),SASSN1(2),SASSN1(3),SASSN1(4),SASSN1(5) 1 ,SASSN1(6),SASSN1(7),SASSN1(8),SASSN1(9),SASSN1(10) 1 ,SASSN1(11),SASSN1(12),SASSN1(13),SASSN1(14)/ 13, 1H , 1H 1 , 1H , 1H , 1H , 1H , 1HA, 1HS, 1HS, 1HI, 1HG 1 , 1HN, 1H / DATA SASSN2(1),SASSN2(2),SASSN2(3),SASSN2(4),SASSN2(5) 1 ,SASSN2(6)/ 5, 1H , 1HT, 1HO, 1H , 1HI/ DATA SB(1),SB(2)/ 1, 1H / DATA SB5I1(1),SB5I1(2),SB5I1(3),SB5I1(4),SB5I1(5),SB5I1(6) 1 ,SB5I1(7)/ 6, 1H , 1H , 1H , 1H , 1H , 1H1/ DATA SB6(1),SB6(2),SB6(3),SB6(4),SB6(5),SB6(6),SB6(7)/ 6, 1H 1 , 1H , 1H , 1H , 1H , 1H / DATA SB7(1),SB7(2),SB7(3),SB7(4),SB7(5),SB7(6),SB7(7),SB7(8)/ 7 1 , 1H , 1H , 1H , 1H , 1H , 1H , 1H / DATA SB6I(1),SB6I(2),SB6I(3),SB6I(4),SB6I(5),SB6I(6),SB6I(7) 1 ,SB6I(8)/ 7, 1H , 1H , 1H , 1H , 1H , 1H , 1HI/ DATA SBGOTO(1),SBGOTO(2),SBGOTO(3),SBGOTO(4),SBGOTO(5) 1 ,SBGOTO(6),SBGOTO(7),SBGOTO(8)/ 7, 1H , 1HG, 1HO, 1H , 1HT 1 , 1HO, 1H / DATA SCOMMA(1),SCOMMA(2)/ 1, 1H,/ DATA SCONT(1),SCONT(2),SCONT(3),SCONT(4),SCONT(5),SCONT(6) 1 ,SCONT(7),SCONT(8),SCONT(9)/ 8, 1HC, 1HO, 1HN, 1HT, 1HI 1 , 1HN, 1HU, 1HE/ DATA SCP(1),SCP(2),SCP(3)/ 2, 1H,, 1H(/ DATA SDOST(1),SDOST(2),SDOST(3),SDOST(4),SDOST(5),SDOST(6) 1 ,SDOST(7),SDOST(8),SDOST(9),SDOST(10)/ 9, 1H , 1H , 1H 1 , 1H , 1H , 1H , 1HD, 1HO, 1H / DATA SDASH(1),SDASH(2),SDASH(3),SDASH(4),SDASH(5),SDASH(6) 1 ,SDASH(7),SDASH(8),SDASH(9),SDASH(10),SDASH(11),SDASH(12) 1 ,SDASH(13),SDASH(14),SDASH(15),SDASH(16),SDASH(17) 1 ,SDASH(18),SDASH(19),SDASH(20),SDASH(21),SDASH(22) 1 ,SDASH(23),SDASH(24),SDASH(25),SDASH(26),SDASH(27) 1 ,SDASH(28),SDASH(29),SDASH(30),SDASH(31),SDASH(32) 1 ,SDASH(33),SDASH(34),SDASH(35),SDASH(36),SDASH(37) 1 ,SDASH(38),SDASH(39),SDASH(40),SDASH(41)/ 40, 1H-, 1H-, 1H- 1 , 1H-, 1H-, 1H-, 1H-, 1H-, 1H-, 1H-, 1H-, 1H- 1 , 1H-, 1H-, 1H-, 1H-, 1H-, 1H-, 1H-, 1H-, 1H- 1 , 1H-, 1H-, 1H-, 1H-, 1H-, 1H-, 1H-, 1H-, 1H- 1 , 1H-, 1H-, 1H-, 1H-, 1H-, 1H-, 1H-, 1H-, 1H- 1 , 1H-/ DATA SDUM(1),SDUM(2),SDUM(3),SDUM(4),SDUM(5),SDUM(6),SDUM(7) 1 ,SDUM(8),SDUM(9),SDUM(10),SDUM(11),SDUM(12),SDUM(13) 1 ,SDUM(14),SDUM(15),SDUM(16)/ 15, 1HD, 1HU, 1HM, 1HM, 1HY 1 , 1H-, 1HP, 1HR, 1HO, 1HC, 1HE, 1HD, 1HU, 1HR 1 , 1HE/ DATA SEQ(1),SEQ(2)/ 1, 1H=/ DATA SFORCE(1),SFORCE(2),SFORCE(3),SFORCE(4),SFORCE(5) 1 ,SFORCE(6),SFORCE(7),SFORCE(8),SFORCE(9),SFORCE(10) 1 ,SFORCE(11),SFORCE(12),SFORCE(13),SFORCE(14),SFORCE(15)/ 14 1 , 1H , 1H , 1H , 1H , 1H , 1H , 1HC, 1HO, 1HN 1 , 1HT, 1HI, 1HN, 1HU, 1HE/ DATA SGOTO(1),SGOTO(2),SGOTO(3),SGOTO(4),SGOTO(5),SGOTO(6) 1 ,SGOTO(7),SGOTO(8),SGOTO(9),SGOTO(10),SGOTO(11),SGOTO(12) 1 ,SGOTO(13)/ 12, 1H , 1H , 1H , 1H , 1H , 1H , 1HG, 1HO, 1H 1 , 1HT, 1HO, 1H / DATA SGOTOI(1),SGOTOI(2),SGOTOI(3),SGOTOI(4),SGOTOI(5) 1 ,SGOTOI(6),SGOTOI(7),SGOTOI(8),SGOTOI(9),SGOTOI(10) 1 ,SGOTOI(11),SGOTOI(12),SGOTOI(13),SGOTOI(14)/ 13, 1H , 1H 1 , 1H , 1H , 1H , 1H , 1HG, 1HO, 1H , 1HT, 1HO 1 , 1H , 1HI/ DATA SGOTOP(1),SGOTOP(2),SGOTOP(3),SGOTOP(4),SGOTOP(5) 1 ,SGOTOP(6),SGOTOP(7),SGOTOP(8),SGOTOP(9),SGOTOP(10) 1 ,SGOTOP(11),SGOTOP(12),SGOTOP(13),SGOTOP(14)/ 13, 1H , 1H 1 , 1H , 1H , 1H , 1H , 1HG, 1HO, 1H , 1HT, 1HO 1 , 1H , 1H(/ DATA SGUP1(1),SGUP1(2),SGUP1(3),SGUP1(4),SGUP1(5),SGUP1(6) 1 ,SGUP1(7),SGUP1(8),SGUP1(9),SGUP1(10),SGUP1(11),SGUP1(12) 1 ,SGUP1(13),SGUP1(14),SGUP1(15),SGUP1(16),SGUP1(17) 1 ,SGUP1(18),SGUP1(19),SGUP1(20),SGUP1(21),SGUP1(22) 1 ,SGUP1(23),SGUP1(24),SGUP1(25),SGUP1(26),SGUP1(27) 1 ,SGUP1(28),SGUP1(29),SGUP1(30),SGUP1(31),SGUP1(32) 1 ,SGUP1(33),SGUP1(34),SGUP1(35),SGUP1(36),SGUP1(37) 1 ,SGUP1(38),SGUP1(39),SGUP1(40),SGUP1(41),SGUP1(42) 1 ,SGUP1(43),SGUP1(44),SGUP1(45),SGUP1(46),SGUP1(47) 1 ,SGUP1(48),SGUP1(49),SGUP1(50),SGUP1(51),SGUP1(52) 1 ,SGUP1(53),SGUP1(54)/ 53, 1H*, 1H*, 1H*, 1H*, 1H*, 1H , 1HT 1 , 1HR, 1HA, 1HN, 1HS, 1HL, 1HA, 1HT, 1HO, 1HR 1 , 1H , 1HH, 1HA, 1HS, 1H , 1HU, 1HS, 1HE, 1HD 1 , 1H , 1HU, 1HP, 1H , 1HA, 1HL, 1HL, 1HO, 1HT 1 , 1HE, 1HD, 1H , 1HS, 1HP, 1HA, 1HC, 1HE, 1H 1 , 1HF, 1HO, 1HR, 1H , 1HT, 1HA, 1HB, 1HL, 1HE 1 , 1HS/ DATA SGUP2(1),SGUP2(2),SGUP2(3),SGUP2(4),SGUP2(5),SGUP2(6) 1 ,SGUP2(7),SGUP2(8),SGUP2(9),SGUP2(10),SGUP2(11),SGUP2(12) 1 ,SGUP2(13),SGUP2(14),SGUP2(15),SGUP2(16),SGUP2(17) 1 ,SGUP2(18),SGUP2(19),SGUP2(20),SGUP2(21),SGUP2(22) 1 ,SGUP2(23),SGUP2(24),SGUP2(25),SGUP2(26),SGUP2(27) 1 ,SGUP2(28),SGUP2(29),SGUP2(30),SGUP2(31),SGUP2(32) 1 ,SGUP2(33),SGUP2(34),SGUP2(35),SGUP2(36),SGUP2(37) 1 ,SGUP2(38),SGUP2(39),SGUP2(40),SGUP2(41),SGUP2(42) 1 ,SGUP2(43),SGUP2(44),SGUP2(45)/ 44, 1H*, 1H*, 1H*, 1H*, 1H* 1 , 1H , 1HT, 1HR, 1HA, 1HN, 1HS, 1HL, 1HA, 1HT 1 , 1HI, 1HO, 1HN, 1H , 1HM, 1HU, 1HS, 1HT, 1H 1 , 1HT, 1HE, 1HR, 1HM, 1HI, 1HN, 1HA, 1HT, 1HE 1 , 1H , 1HI, 1HM, 1HM, 1HE, 1HD, 1HI, 1HA, 1HT 1 , 1HE, 1HL, 1HY/ DATA SIF(1),SIF(2),SIF(3),SIF(4),SIF(5),SIF(6),SIF(7),SIF(8) 1 ,SIF(9)/ 8, 1H , 1H , 1H , 1H , 1H , 1H , 1HI, 1HF/ DATA SIFP(1),SIFP(2),SIFP(3),SIFP(4),SIFP(5),SIFP(6),SIFP(7) 1 ,SIFP(8),SIFP(9),SIFP(10)/ 9, 1H , 1H , 1H , 1H , 1H , 1H 1 , 1HI, 1HF, 1H(/ DATA SIFPN(1),SIFPN(2),SIFPN(3),SIFPN(4),SIFPN(5),SIFPN(6) 1 ,SIFPN(7),SIFPN(8),SIFPN(9),SIFPN(10),SIFPN(11),SIFPN(12) 1 ,SIFPN(13),SIFPN(14),SIFPN(15)/ 14, 1H , 1H , 1H , 1H , 1H 1 , 1H , 1HI, 1HF, 1H(, 1H., 1HN, 1HO, 1HT, 1H./ DATA SNE(1),SNE(2),SNE(3),SNE(4),SNE(5)/ 4, 1H., 1HN, 1HE, 1H./ DATA SPB(1),SPB(2),SPB(3)/ 2, 1H), 1H / DATA SPGOTO(1),SPGOTO(2),SPGOTO(3),SPGOTO(4),SPGOTO(5) 1 ,SPGOTO(6),SPGOTO(7),SPGOTO(8),SPGOTO(9)/ 8, 1H), 1H , 1HG 1 , 1HO, 1H , 1HT, 1HO, 1H / DATA SRP(1),SRP(2)/ 1, 1H)/ DATA SRPCI(1),SRPCI(2),SRPCI(3),SRPCI(4),SRPCI(5)/ 4, 1H), 1H, 1 , 1H , 1HI/ DATA SRTN(1),SRTN(2),SRTN(3),SRTN(4),SRTN(5),SRTN(6),SRTN(7) 1 ,SRTN(8),SRTN(9),SRTN(10),SRTN(11),SRTN(12),SRTN(13)/ 12 1 , 1H , 1H , 1H , 1H , 1H , 1H , 1HR, 1HE, 1HT 1 , 1HU, 1HR, 1HN/ DATA SSTOP(1),SSTOP(2),SSTOP(3),SSTOP(4),SSTOP(5),SSTOP(6) 1 ,SSTOP(7),SSTOP(8),SSTOP(9),SSTOP(10),SSTOP(11),SSTOP(12) 1 ,SSTOP(13),SSTOP(14),SSTOP(15),SSTOP(16)/ 15, 1H , 1H , 1H 1 , 1H , 1H , 1H , 1HC, 1HA, 1HL, 1HL, 1H , 1HE 1 , 1HX, 1HI, 1HT/ DATA SVER(1),SVER(2),SVER(3),SVER(4),SVER(5),SVER(6),SVER(7) 1 ,SVER(8),SVER(9),SVER(10),SVER(11),SVER(12),SVER(13) 1 ,SVER(14),SVER(15),SVER(16),SVER(17),SVER(18),SVER(19) 1 ,SVER(20),SVER(21),SVER(22)/ 21, 1HF, 1HL, 1HE, 1HC, 1HS 1 , 1H/, 1HR, 1HT, 1H-, 1H1, 1H1, 1H , 1HV, 1H2 1 , 1H8, 1H., 1H0, 1H1, 1H , 1H , 1H / C RT11=.TRUE. REPEAT WHILE (RT11) PERFORM-INITIALIZATION REPEAT UNTIL (DONE) NOCALL=NOCALL+1 CALL OPENF(NOCALL,DONE,SVER) UNLESS (DONE) ENDFIL=.FALSE. MINCNT=0 MAJCNT=0 LINENO=0 REPEAT UNTIL (ENDFIL) PREPARE-TO-PROCESS-PROGRAM PROCESS-PROGRAM FIN CALL CLOSEF(MINCNT,MAJCNT) FIN FIN FIN CALL EXIT C TO COMPILE-CEXP GENERATE-BRANCH-AROUND-AND-ESTABLISH-NEXT-NUMBER SET-UP-STATEMENT-NUMBER WHEN (UTYPE(1).EQ.UEXP) GOTONO=NEWNO(0) STACK(TOP-2)=GOTONO STNO=0 PUT-IF-NOT-GOTO FIN ELSE STACK(TOP-2)=0 COMPLETE-ACTION FIN C TO COMPILE-CONDITIONAL TOP=TOP+4 STACK(TOP)=ACSEQ STACK(TOP-1)=LINENO STACK(TOP-2)=0 STACK(TOP-3)=0 LEVEL=LEVEL+1 SET-UP-STATEMENT-NUMBER FIN C TO COMPILE-DO CONTNO=NEWNO(0) PUSH-GCONT CALL CPYSTR(SST,SDOST) CALL CATNUM(SST,CONTNO) CALL CATSTR(SST,SB) CALL CATSUB(SST,SFLX,USTART(1)+1,ULEN(1)-2) STNO=FLXNO FLXNO=0 PUT-STATEMENT COMPLETE-ACTION FIN C TO COMPILE-ELSE TOP=TOP-2 SET-UP-STATEMENT-NUMBER WHEN (NUNITS.EQ.1) WHEN (UTYPE(1).EQ.UPINV) COMPILE-INVOKE ELSE CALL CPYSUB(SST,SFLX,USTART(1),ULEN(1)) UNLESS (STREQ(SST,SCONT)) COMPILE-FORTRAN FIN FIN ELSE PUSH-FINSEQ FIN C TO COMPILE-END SORT-TABLE IF (LONG.OR.COGOTO) GENERATE-PROCEDURE-DISPATCH-AREA PUT-COPY IF (ENDFIL) ERROR=25 ENDPGM=.TRUE. FIN C 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 C TO COMPILE-FORTRAN STNO=FLXNO CALL CPYSTR(SST,SB6) WHEN (UTYPE(1).EQ.UFORT) J=1 ELSE J=2 CALL CATSUB(SST,SFLX,USTART(J),ULEN(J)) PUT-STATEMENT FIN C TO COMPILE-IF WHEN (NUNITS.EQ.2.AND.UTYPE(2).EQ.UFORT) PUT-COPY ELSE FINISH-IF-UNLESS FIN C TO COMPILE-INVOKE FIND-ENTRY ENTNO=STACK(PENT+1) RETNO=NEWNO(0) MAX=MAX-(1+OFFSET) STACK(MAX+1)=STACK(PENT+3) STACK(PENT+3)=MAX+1 STACK(MAX+2)=LINENO IF (LONG.OR.COGOTO) STACK(MAX+3)=RETNO WHEN (COGOTO) STACK(PENT-2)=STACK(PENT-2)+1 CALL CPYSTR(SST,SB6I) CALL CATNUM(SST,ENTNO) CALL CATSTR(SST,SEQ) CALL CATNUM(SST,STACK(PENT-2)) FIN ELSE CALL CPYSTR(SST,SASSN1) CALL CATNUM(SST,RETNO) CALL CATSTR(SST,SASSN2) CALL CATNUM(SST,ENTNO) FIN STNO=FLXNO PUT-STATEMENT GOTONO=ENTNO PUT-GOTO NEXTNO=RETNO FIN C TO COMPILE-RUNTIL NOTFLG=.FALSE. COMPILE-RWHILE FIN C TO COMPILE-RWHILE SET-UP-STATEMENT-NUMBER TESTNO=NEWNO(0) TOPNO=NEWNO(0) ENDNO=NEWNO(0) GOTONO=TOPNO PUT-GOTO STNO=TESTNO GOTONO=ENDNO PUT-IF-NOT-GOTO GSTNO=ENDNO PUSH-GSTNO GGOTON=TESTNO PUSH-GGOTO NEXTNO=TOPNO COMPLETE-ACTION FIN C TO COMPILE-SELECT SET-UP-STATEMENT-NUMBER LEVEL=LEVEL+1 L=ULEN(1)+5 TOP=TOP+L+1 WHEN (TOP+SAFETY.LT.MAX) STACK(TOP)=ASSEQ STACK(TOP-1)=LINENO STACK(TOP-2)=0 STACK(TOP-3)=0 STACK(TOP-4)=L I=TOP-L STACK(I)=0 CALL CATSUB(STACK(I),SFLX,USTART(1),ULEN(1)) FIN ELSE GIVE-UP FIN C TO COMPILE-SEQ-FIN LEVEL=LEVEL-1 SET-UP-STATEMENT-NUMBER STNO=STACK(TOP-2) UNLESS (STNO.EQ.0) PUT-CONTINUE FORCE-NEXT-NUMBER NEXTNO=STACK(TOP-3) POP-STACK FIN C TO COMPILE-SEXP GENERATE-BRANCH-AROUND-AND-ESTABLISH-NEXT-NUMBER SET-UP-STATEMENT-NUMBER WHEN (UTYPE(1).EQ.UEXP) CALL CPYSTR(SST,SIFP) CALL CATSUB(SST,SFLX,USTART(1),ULEN(1)) CALL CATSTR(SST,SNE) I=TOP-STACK(TOP-4) CALL CATSTR(SST,STACK(I)) CALL CATSTR(SST,SPGOTO) NXIFNO=NEWNO(0) STACK(TOP-2)=NXIFNO CALL CATNUM(SST,NXIFNO) STNO=0 PUT-STATEMENT FIN ELSE STACK(TOP-2)=0 COMPLETE-ACTION FIN C TO COMPILE-SIMPLE-FIN SET-UP-STATEMENT-NUMBER LEVEL=LEVEL-1 TOP=TOP-2 FIN C TO COMPILE-TO 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 SET-UP-STATEMENT-NUMBER FORCE-NEXT-NUMBER NEXTNO=ENTNO FORCE-NEXT-NUMBER TOP=TOP+2 STACK(TOP)=AGRET WHEN (SHORT.OR.FAKE) STACK(TOP-1)=ENTNO ELSE STACK(TOP-1)=STACK(PENT-1) UTYPE(1)=0 COMPLETE-ACTION FIN C TO COMPILE-UNLESS WHEN (NUNITS.EQ.2.AND.UTYPE(2).EQ.UFORT) CALL CPYSTR(SST,SIFPN) CALL CATSUB(SST,SFLX,USTART(1),ULEN(1)) CALL CATSTR(SST,SPB) CALL CATSUB(SST,SFLX,USTART(2),ULEN(2)) STNO=FLXNO PUT-STATEMENT FIN ELSE NOTFLG=.FALSE. FINISH-IF-UNLESS FIN FIN C TO COMPILE-UNTIL NOTFLG=.FALSE. COMPILE-WHILE FIN C TO COMPILE-WHEN ENDNO=NEWNO(0) ELSNO=NEWNO(0) GSTNO=ENDNO PUSH-GSTNO TOP=TOP+2 STACK(TOP-1)=LINENO STACK(TOP)=AELSE GSTNO=ELSNO PUSH-GSTNO GGOTON=ENDNO PUSH-GGOTO GOTONO=ELSNO STNO=FLXNO FLXNO=0 PUT-IF-NOT-GOTO COMPLETE-ACTION FIN C TO COMPILE-WHILE CONDITIONAL (FLXNO.NE.0) LOOPNO=FLXNO FLXNO=0 FIN (NEXTNO.NE.0) LOOPNO=NEXTNO NEXTNO=0 FIN (OTHERWISE) LOOPNO=NEWNO(0) FIN FIN ENDNO=NEWNO(0) GSTNO=ENDNO PUSH-GSTNO GGOTON=LOOPNO PUSH-GGOTO GOTONO=ENDNO STNO=LOOPNO PUT-IF-NOT-GOTO COMPLETE-ACTION FIN C TO COMPLETE-ACTION CONDITIONAL (NUNITS.EQ.1) PUSH-FINSEQ (UTYPE(2).EQ.UPINV) COMPILE-INVOKE (OTHERWISE) CALL CPYSUB(SST,SFLX,USTART(2),ULEN(2)) UNLESS (STREQ(SST,SCONT)) COMPILE-FORTRAN FIN FIN FIN C TO FIND-ENTRY WHEN (UTYPE(1).EQ.UPINV) J=1 ELSE J=2 CALL CPYSUB(SPINV,SFLX,USTART(J),ULEN(J)) WHEN (STREQ(SPINV,SDUM)) PENT=PDUMMY STACK(PENT+2)=0 FIN ELSE P=MAXSTK-HASH(SPINV,PRIME) FOUND=.FALSE. UNLESS(STACK(P).EQ.0) REPEAT UNTIL(STACK(P).EQ.0.OR.FOUND) P=STACK(P) IF (STREQ(SPINV,STACK(P+4))) FOUND=.TRUE. FIN FIN WHEN (FOUND) PENT=P ELSE TMAX=MAX-OFFST2-SPINV(1)-4 WHEN (TMAX.LE.TOP+SAFETY) PENT=PDUMMY STACK(PENT+2)=0 FIN ELSE MAX=TMAX PENT=MAX+OFFST2 IF (LONG.OR.COGOTO) STACK(PENT-1)=NEWNO(0) IF (COGOTO) STACK(PENT-2)=0 STACK(PENT)=0 STACK(P)=PENT STACK(PENT+1)=NEWNO(0) STACK(PENT+2)=0 STACK(PENT+3)=0 CALL CPYSTR(STACK(PENT+4),SPINV) FIN FIN FIN FIN C TO FINISH-IF-UNLESS GOTONO=NEWNO(0) STNO=FLXNO FLXNO=0 PUT-IF-NOT-GOTO GSTNO=GOTONO PUSH-GSTNO COMPLETE-ACTION FIN C TO FORCE-NEXT-NUMBER UNLESS(FORTOF) IF (NEXTNO.NE.0) CALL PUTNUM(SFORCE,NEXTNO) CALL PUT(LINENO,SFORCE,FORTCL) NEXTNO=0 FIN FIN FIN C TO GENERATE-BRANCH-AROUND-AND-ESTABLISH-NEXT-NUMBER ENDNO=STACK(TOP-3) WHEN (ENDNO.EQ.0) STACK(TOP-3)=NEWNO(0) FIN ELSE GOTONO=ENDNO PUT-GOTO FIN CONDITIONAL (NEXTNO.EQ.0) NEXTNO=STACK(TOP-2) (STACK(TOP-2).EQ.0) CONTINUE (OTHERWISE) FORCE-NEXT-NUMBER NEXTNO=STACK(TOP-2) FIN FIN FIN C TO GENERATE-CONTINUE STNO=STACK(TOP-1) PUT-CONTINUE TOP=TOP-2 FIN C TO GENERATE-GOTO GOTONO=STACK(TOP-1) PUT-GOTO TOP=TOP-2 FIN C TO GENERATE-PROCEDURE-DISPATCH-AREA P=PTABLE UNTIL (P.EQ.0) WHEN (STACK(P+2).NE.0) WHEN (LONG) CALL CPYSTR(SST,SGOTOI) CALL CATNUM(SST,STACK(P+1)) CALL CATSTR(SST,SCP) FIN ELSE CALL CPYSTR(SST,SGOTOP) Q=STACK(P+3) STNO=STACK(P-1) WHEN(Q.EQ.0) CALL CATNUM(SST,STACK(P+1)) ELSE REPEAT UNTIL (Q.EQ.0) IF (SST(1).GT.SSTMAX-6) PUT-STATEMENT CALL CPYSTR(SST,SB5I1) FIN CALL CATNUM(SST,STACK(Q+2)) CALL CATSTR(SST,SCOMMA) Q=STACK(Q) FIN SST(1)=SST(1)-1 FIN WHEN (LONG) CALL CATSTR(SST,SRP) ELSE IF(SST(1).GT.SSTMAX-9) PUT-STATEMENT CALL CPYSTR(SST,SB5I1) FIN CALL CATSTR(SST,SRPCI) CALL CATNUM(SST,STACK(P+1)) FIN PUT-STATEMENT FIN ELSE CALL CPYSTR(SST,SSTOP) STNO=STACK(P+1) PUT-STATEMENT FIN P=STACK(P) FIN FIN C TO GENERATE-RETURN-FROM-PROC STNO=0 CALL CPYSTR(SST,SGOTOI) IF (LONG.OR.COGOTO) SST(1)=SST(1)-1 CALL CATNUM(SST,STACK(TOP-1)) IF (FAKE) CALL CATSTR(SST,SCP) CALL CATNUM(SST,STACK(TOP-1)) CALL CATSTR(SST,SRP) FIN PUT-STATEMENT TOP=TOP-2 FIN C TO GENERATE-STATEMENT-NUMBER FORCE-NEXT-NUMBER NEXTNO=STACK(TOP-1) TOP=TOP-2 FIN C TO GIVE-UP CALL PUT(0,SGUP1,ERRCL) CALL PUT(0,SGUP2,ERRCL) CALL CLOSEF(MINCNT,-1) IF (.TRUE.) CALL EXIT FIN C TO PERFORM-INITIALIZATION C NOCALL=0 CONDOF=.FALSE. NEWVER=.FALSE. FORTOF=.FALSE. LISTOF=.FALSE. SHORT=.TRUE. FAKE=.FALSE. LONG=.FALSE. COGOTO=.FALSE. SSPACR(1)=3 SSPACR(2)=CHPERD SSPACR(3)=CHSPAC SSPACR(4)=CHSPAC SFSPCR(1)=3 SFSPCR(2)=CHPERD SFSPCR(3)=CHPERD SFSPCR(4)=CHPERD BLN=0 WWIDTH=LWIDTH-6 REFNO=(LWIDTH-12)/7 CONDITIONAL (SHORT.OR.FAKE) OFFSET=1 OFFST2=1 FIN (OTHERWISE) OFFSET=2 OFFST2=3 FIN FIN NOTFLG=.TRUE. ERLST=.FALSE. FIN C TO POP-STACK TOPTYP=STACK(TOP) SELECT (TOPTYP) (ASSEQ) TOP=TOP-STACK(TOP-4)-1 (ACSEQ) TOP=TOP-4 (AGGOTO) TOP=TOP-2 (AGCONT) TOP=TOP-2 (AFSEQ) TOP=TOP-2 (AELSE) TOP=TOP-2 (AGSTNO) TOP=TOP-2 (ATSEQ) TOP=TOP-1 (AMSEQ) TOP=TOP-1 (AGRET) TOP=TOP-2 FIN FIN C TO PREPARE-TO-PROCESS-PROGRAM DUMMY=NEWNO(SEEDNO) ENDPGM=.FALSE. MAX=MAXSTK-(PRIME+OFFSET+3) PDUMMY=MAX+OFFSET DO (I=MAX,MAXSTK) STACK(I)=0 TOP=1 STACK(TOP)=AMSEQ ERROR=0 FIRST=.TRUE. NOPGM=.FALSE. NEXTNO=0 SOURCE=READ LEVEL=0 LSTLEV=0 FIN C TO PROCESS-PROGRAM REPEAT UNTIL (ENDPGM) IF(TOP+SAFETY.GT.MAX) GIVE-UP ACTION=STACK(TOP) SELECT (ACTION) (AGGOTO) GENERATE-GOTO (AGRET) GENERATE-RETURN-FROM-PROC (AGCONT) GENERATE-CONTINUE (AGSTNO) GENERATE-STATEMENT-NUMBER (OTHERWISE) C C*********************************************************************** C CALL ANALYZ C C*********************************************************************** C SELECT (ACTION) (AFSEQ) SELECT(CLASS) (TEXEC) COMPILE-EXEC (TFIN) COMPILE-SIMPLE-FIN (TEND) ERROR=1 (TELSE) ERROR=10 (TTO) ERROR=13 (TCEXP) ERROR=19 FIN FIN (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 FIN C C*********************************************************************** C UNLESS (NOPGM) CALL LIST C C*********************************************************************** C FIN FIN FIN FIN C TO PUSH-FINSEQ TOP=TOP+2 STACK(TOP-1)=LINENO STACK(TOP)=AFSEQ LEVEL=LEVEL+1 FIN C TO PUSH-GCONT TOP=TOP+2 STACK(TOP-1)=CONTNO STACK(TOP)=AGCONT FIN C TO PUSH-GGOTO TOP=TOP+2 STACK(TOP-1)=GGOTON STACK(TOP)=AGGOTO FIN C TO PUSH-GSTNO TOP=TOP+2 STACK(TOP-1)=GSTNO STACK(TOP)=AGSTNO FIN C TO PUT-CONTINUE UNLESS(FORTOF) FORCE-NEXT-NUMBER CALL PUTNUM(SFORCE,STNO) CALL PUT(LINENO,SFORCE,FORTCL) STNO=0 FIN FIN C TO PUT-COPY UNLESS(FORTOF) CONDITIONAL (NEXTNO.EQ.0) CALL PUT(LINENO,SFLX,FORTCL) (FLXNO.NE.0.OR.PASS) FORCE-NEXT-NUMBER CALL PUT(LINENO,SFLX,FORTCL) FIN (OTHERWISE) CALL CPYSTR(SST,SFLX) CALL PUTNUM(SST,NEXTNO) CALL PUT(LINENO,SST,FORTCL) NEXTNO=0 FIN FIN FIN FIN C TO PUT-GOTO UNLESS(FORTOF) CALL CPYSTR(SPUTGO,SGOTO) CALL CATNUM(SPUTGO,GOTONO) IF (NEXTNO.NE.0) CALL PUTNUM(SPUTGO,NEXTNO) NEXTNO=0 FIN CALL PUT(LINENO,SPUTGO,FORTCL) FIN FIN C TO PUT-IF-NOT-GOTO UNLESS(FORTOF) WHEN(NOTFLG) CALL CPYSTR(SST,SIFPN) ELSE CALL CPYSTR(SST,SIF) CALL CATSUB(SST,SFLX,USTART(1),ULEN(1)) WHEN (NOTFLG) CALL CATSTR(SST,SPGOTO) ELSE CALL CATSTR(SST,SBGOTO) CALL CATNUM(SST,GOTONO) PUT-STATEMENT NOTFLG=.TRUE. FIN FIN C TO PUT-STATEMENT UNLESS(FORTOF) UNLESS (NEXTNO.EQ.0) WHEN (STNO.EQ.0) STNO=NEXTNO NEXTNO=0 FIN ELSE FORCE-NEXT-NUMBER FIN UNLESS (STNO.EQ.0) CALL PUTNUM(SST,STNO) STNO=0 FIN WHEN (SST(1).LE.72) CALL PUT(LINENO,SST,FORTCL) ELSE CALL CPYSUB (SLIST,SST,1,72) CALL PUT(LINENO,SLIST,FORTCL) S=73 L=66 REPEAT UNTIL (S.GT.SST(1)) IF(S+L-1.GT.SST(1)) L=SST(1)-S+1 CALL CPYSTR(SLIST,SB5I1) CALL CATSUB(SLIST,SST,S,L) CALL PUT(LINENO,SLIST,FORTCL) S=S+66 FIN FIN FIN FIN C TO REVERSE-LIST LL=0 LR=STACK(LP) UNTIL (LR.EQ.0) LT=STACK(LR) STACK(LR)=LL LL=LR LR=LT FIN STACK(LP)=LL FIN C TO SET-UP-STATEMENT-NUMBER IF (FLXNO.NE.0) FORCE-NEXT-NUMBER NEXTNO=FLXNO FLXNO=0 FIN FIN C TO SORT-TABLE P=MAX STACK(MAX)=0 ITEMP=MAXSTK-PRIME+1 DO (I=ITEMP,MAXSTK) UNLESS (STACK(I).EQ.0) STACK(P)=STACK(I) REPEAT UNTIL (STACK(P).EQ.0) P=STACK(P) LP=P+3 REVERSE-LIST FIN FIN FIN Q=MAX-1 STACK(Q)=0 UNTIL (STACK(MAX).EQ.0) P=STACK(MAX) STACK(MAX)=STACK(P) QM=Q QP=STACK(QM) INSERT=.FALSE. UNTIL (INSERT) CONDITIONAL (QP.EQ.0) INSERT=.TRUE. (STRLT(STACK(P+4),STACK(QP+4))) INSERT=.TRUE. (OTHERWISE) QM=QP QP=STACK(QM) FIN FIN FIN STACK(P)=QP STACK(QM)=P FIN PTABLE=STACK(Q) FIN C C END