PROGRAM FLECS 00097 INTEGER NUMLIN !830307 MAO 00222 LOGICAL CNTALL !830307 MAO 00223 COMMON/FLINE/CNTALL,NUMLIN 00224 INTEGER DTYPE !22-JUN-81 (MAO) 00226 COMMON/DIR/DTYPE !22-JUN-81 (MAO) 00227 LOGICAL PASFLG !30JUN81MAO 00229 INTEGER CNDLVL !30JUN81MAO 00230 INTEGER OFFLVL !30JUN81MAO 00231 INTEGER COND !30JUN81MAO 00232 INTEGER CNDVAL !30JUN81MAO 00233 COMMON/COND/PASFLG,CNDLVL,OFFLVL,COND,CNDVAL(4,10) !30JUN81MAO 00234 COMMON/IFBLK/BLKIF !860214 00236 INTEGER*2 BLKIF !860214 00237 INTEGER POUND !26-JUN-81MAO 00242 INTEGER TDIR !22-JUN-81MAO 00243 INTEGER TOFF !30JUN81MAO 00244 INTEGER DPAGE !22-JUN-81MAO 00245 INTEGER DPIF,DPUNL,DPEND !30JUN81MAO 00246 INTEGER DNAME !30JUN81MAO 00247 INTEGER DINCL !29-JUN-81MAO 00248 INTEGER UDIR !29-JUN-81MAO 00249 INTEGER DIMP !840307MAO 00250 INTEGER ACSEQ , ACTION, AELSE , AFSEQ , AGCONT, AGGOTO 00251 INTEGER*2 AELS77 !860214 00253 INTEGER*2 AGENDD !850625 00254 INTEGER*2 AGENDI !850516MAO 00255 INTEGER AGRET , AGSTNO, AMSEQ ,ASSEQ , ATSEQ 00257 INTEGER BLN , NOCALL, CHC , CHSPAC, CHZERO 00258 INTEGER CINLIN !25-JAN-80 00259 INTEGER CLASS , CONTNO, DUMMY , ELSNO , ENDNO , ENTNO 00260 INTEGER ERRCL , ERROR , ERRSTK, ERSTOP, EXTYPE, FLXNO 00261 INTEGER FORTCL, GGOTON, GOTONO, GSTNO , HASH , HOLDNO 00262 INTEGER I , ITEMP , J , L , LEVEL , LINENO 00263 INTEGER*2 JJ !860212 00264 INTEGER LL , LP , LR , LT 00265 INTEGER LISTCL, LOOPNO, LSTLEV, LWIDTH, MAJCNT 00266 INTEGER MAX , MAXSTK, MINCNT, MLINE , NCHPWD, NEWNO 00267 INTEGER NEXTNO, NUNITS, NXIFNO, OFFSET, OFFST2, P 00268 INTEGER PARAM1, PARAM2, PARAM3, PARAM4, PDUMMY, PENT 00269 INTEGER PARAM5 !25-JAN-80 00270 INTEGER PRIME , PTABLE, Q , QM , QP , READ 00271 INTEGER REFNO , RETNO , RETRY , S , SAFETY, SASSN1 00272 INTEGER SASSN2, SB , SB5I1 , SB6 , SB6I , SB7 , SBGOTO 00273 INTEGER SCONT 00274 INTEGER SCOMMA, SCP , SDASH , SDOST , SDUM , SEEDNO, SEQ 00275 INTEGER*2 SDOWHI !850626 00277 INTEGER*2 SEIF !850625 00278 INTEGER*2 SELSE !850624mao 00279 INTEGER*2 SENDDO !850625 00280 INTEGER*2 SENDIF !850516MAO 00281 INTEGER*2 SEQL !850625 00282 INTEGER*2 SFALSE !850626 00283 INTEGER SETUP , SFLX , SFORCE, SGOTO , SGOTOI, SGUP1 00285 INTEGER SGOTOP 00286 INTEGER*2 SI !850626 00288 INTEGER SGUP2 , SHOLD , SIF , SIFP , SIFPN , SLIST 00290 INTEGER*2 SLP !850625 00292 INTEGER*2 SOR !850626 00293 INTEGER SNE , SOURCE, SPB , SPGOTO, SPINV , SPUTGO 00295 INTEGER*2 SPNOT !850626 00297 INTEGER*2 SPTHEN,STHEN !850516 00298 INTEGER SRP , SRTN , SSPACR, SST , SSTMAX, SSTOP 00300 INTEGER SRPCI 00301 INTEGER*2 STRUE !850625 00303 INTEGER STACK , STNO , SVER , TCEXP , TCOND , TDO 00305 INTEGER TDO77 , TENDDO, TELSIF, TENDIF, TIFTHN !860214 00306 INTEGER TELSE , TEND , TESTNO, TEXEC , TFIN , TFORT 00307 INTEGER TIF , TINVOK, TMAX , TOP , TOPNO , TOPTYP 00308 INTEGER TRUNTL, TRWHIL, TSELCT, TTO , TUNLES, TUNTIL 00309 INTEGER TWHEN , TWHILE, UDO , UEXP , UFORT , ULEN 00310 INTEGER UOWSE , UPINV , USTART, UTYPE , WWIDTH 00311 LOGICAL ALECS !20-FEB-80 00318 LOGICAL IMPSET !840307MAO 00319 LOGICAL COGOTO, FAKE , LONG 00320 LOGICAL DONE , ENDFIL, ENDPGM, ERLST , FIRST , FOUND , INSERT 00321 LOGICAL NOPGM , NOTFLG, PASS , SAVED ,SHORT , STREQ , STRLT 00322 LOGICAL*2 FINEDO !.T.==>FIN should generate an ENDDO !850625 00324 LOGICAL*2 FINEIF !.T.==>FIN should generate an ENDIF !850625 00325 LOGICAL*2 FCSEXP !.T.==>next cond or select clause is 1st!850625 00326 DIMENSION UTYPE(3), USTART(3), ULEN(3) 00335 DIMENSION STACK(2000) 00338 DIMENSION ERRSTK(5) 00341 COMMON BLN , CLASS , DONE , ENDFIL, ENDPGM, ERLST 00350 COMMON ERROR , ERRSTK, ERSTOP, EXTYPE, FIRST , FLXNO 00351 COMMON FOUND , HOLDNO, LEVEL , LINENO, LSTLEV, MAJCNT 00352 COMMON MINCNT, MLINE , NOPGM , NUNITS, PASS , PTABLE, QP 00353 COMMON REFNO , SAVED , SFLX , SHOLD , SLIST , SOURCE 00354 COMMON SPINV , SPUTGO, SST , STACK , TOP , ULEN 00355 COMMON USTART, UTYPE , WWIDTH 00356 COMMON /PARAM/ PARAM1, PARAM2, PARAM3, PARAM4, PARAM5 !25-JAN-80 00455 DIMENSION SFLX (51) 00468 DIMENSION SHOLD (51) 00470 DIMENSION SLIST (101) 00472 DIMENSION SPINV (41) 00474 DIMENSION SPUTGO (11) 00476 DIMENSION SST (101) 00478 BYTE SSTB(202) !860212 00479 EQUIVALENCE (SST(1),SSTB(1)) !860212 00480 DIMENSION SASSN1 (8) 00486 DIMENSION SASSN2 (4) 00489 DIMENSION SB (2) 00492 DIMENSION SB5I1 (4) 00495 DIMENSION SB6 (4) 00498 DIMENSION SB7 (5) 00501 DIMENSION SB6I (5) 00504 DIMENSION SBGOTO (5) 00507 DIMENSION SCOMMA (2) 00510 DIMENSION SCONT (5) 00513 DIMENSION SCP (2) 00516 DIMENSION SDOST (6) 00519 DIMENSION SDASH (21) 00522 DIMENSION SDOWHI (8) !850626 00528 DIMENSION SDUM (9) 00532 DIMENSION SEIF (7) !850625 00536 DIMENSION SELSE (6) !850624 00539 DIMENSION SENDDO (7) !850625 00542 DIMENSION SENDIF (7) !850516 00545 DIMENSION SEQ (2) 00549 DIMENSION SEQL (3) !850625 00553 DIMENSION SFALSE (5) !850626 00556 DIMENSION SFORCE (8) 00560 DIMENSION SGOTO (7) 00563 DIMENSION SGOTOI (8) 00566 DIMENSION SGOTOP (8) 00569 DIMENSION SGUP1 (30) 00572 DIMENSION SGUP2 (23) 00578 DIMENSION SI (2) !850626 00584 DIMENSION SIF (5) 00588 DIMENSION SIFP (6) 00591 DIMENSION SIFPN (8) 00594 DIMENSION SLP (2) !850625 00598 DIMENSION SNE (3) 00602 DIMENSION SOR (3) !850626 00606 DIMENSION SPB (2) 00610 DIMENSION SPGOTO (5) 00613 DIMENSION SPNOT (4) !850626 00617 DIMENSION SPTHEN (4) !850516 00620 DIMENSION SRP (2) 00624 DIMENSION SRPCI (3) 00627 DIMENSION SRTN (7) 00630 DIMENSION SSPACR (3) 00633 DIMENSION SSTOP (9) 00636 DIMENSION STHEN (4) !850516 00640 DIMENSION STRUE (4) !850625 00643 DIMENSION SVER (12) 00647 DATA POUND/"43/ !# SIGN FOR COLUMN 1 !26-JUN-81MAO 00656 DATA FORTCL /1/, LISTCL /2/, ERRCL /3/ 00657 DATA ACSEQ/1/, AELSE/2/, AFSEQ/3/, AGCONT/4/, AGGOTO/5/ 00658 DATA AGSTNO/6/, AMSEQ/7/, AGRET/8/, ASSEQ/9/, ATSEQ/10/ 00659 DATA AELS77/13/ !860214 00661 DATA AGENDD/12/ !850625 00662 DATA AGENDI/11/ !850516 00663 DATA UEXP/1/, UFORT/2/, UOWSE/3/, UPINV/4/, UDO/5/ 00665 DATA UDIR/6/ !29-JUN-81MAO 00666 DATA TCEXP/1/, TELSE/2/, TEND/3/, TEXEC/4/, TFIN/5/, TTO/6/ 00667 DATA TDIR /7/ !22-JUN-81 00668 DATA TOFF /8/ !30JUN81MAO 00669 DATA TENDDO /9/ !860214 00670 DATA TELSIF /10/, TENDIF /11/ !860214 00671 DATA TCOND/1/, TDO/2/, TFORT/3/, TIF/4/, TINVOK/5/, TRUNTL/6/ 00672 DATA TRWHIL/7/, TSELCT/8/, TUNLES/9/, TUNTIL/10/, TWHEN/11/ 00673 DATA TWHILE/12/ 00674 DATA TDO77/13/ !860214 00675 DATA TIFTHN/14/ !860214 00676 DATA DPAGE /1/ !22-JUN-81 00677 DATA DINCL /2/ !29-JUN-81MAO 00678 DATA DPIF /3/, DPUNL /4/, DPEND /5/ !30JUN81MAO 00679 DATA DNAME /6/ !30JUN81MAO 00680 DATA DIMP /7/ !840307MAO 00681 DATA SETUP /1/, RETRY /2/, READ /3/ 00682 DATA CHC /67/ 00683 DATA CINLIN /33/ !25-JAN-80 00684 DATA LWIDTH /132/ 00685 DATA MAXSTK /2000/ 00686 DATA NCHPWD /2/ 00687 DATA PRIME /53/ 00688 DATA SAFETY /35/ 00689 DATA SEEDNO /32760/ 00690 DATA LONG /.FALSE./ 00691 DATA SHORT /.TRUE./ 00692 DATA FAKE /.FALSE./ 00693 DATA COGOTO /.FALSE./ 00694 DATA CHSPAC /32/ 00695 DATA CHZERO /48/ 00696 DATA SSTMAX /200/ 00697 DATA SASSN1 / 13, 2H , 2H , 2H , 2HAS, 2HSI, 2HGN, 1H / 00698 DATA SASSN2 / 5, 2H T, 2HO , 1HI/ 00699 DATA SB / 1, 1H / 00700 DATA SB5I1 / 6, 2H , 2H , 2H 1/ 00701 DATA SB6 / 6, 2H , 2H , 2H / 00702 DATA SB7 / 7, 2H , 2H , 2H , 1H / 00703 DATA SB6I / 7, 2H , 2H , 2H , 1HI/ 00704 DATA SBGOTO / 7, 2H G, 2HO , 2HTO, 1H / 00705 DATA SCOMMA / 1, 1H,/ 00706 DATA SCONT / 8, 2HCO, 2HNT, 2HIN, 2HUE/ 00707 DATA SCP / 2, 2H,(/ 00708 DATA SDOST / 9, 2H , 2H , 2H , 2HDO, 1H / 00709 DATA SDASH / 40, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00710 1 , 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00711 1 , 2H--, 2H--, 2H--, 2H--/ 00712 DATA SDOWHI / 13, 2H , 2H , 2H , 2HDO, 2HWH, 2HIL, 1HE /!8506200714 DATA SDUM / 15, 2HDU, 2HMM, 2HY-, 2HPR, 2HOC, 2HED, 2HUR, 1HE/ 00716 DATA SEIF / 12, 2H , 2H , 2H , 2HEL, 2HSE, 2HIF/ !850625 00718 DATA SELSE / 10, 2H , 2H , 2H , 2HEL, 2HSE/ !850624 00719 DATA SENDDO / 11, 2H , 2H , 2H , 2HEN, 2HDD, 1HO/ !850625 00720 DATA SENDIF / 11, 2H , 2H , 2H , 2HEN, 2HDI, 1HF/ !850516 00721 DATA SEQ / 1, 1H=/ 00723 DATA SEQL / 4, 2H.E, 2HQ./ !850625 00725 DATA SFALSE / 7, 2H.F, 2HAL, 2HSE, 1H./ !850626 00726 DATA SFORCE / 14, 2H , 2H , 2H , 2HCO, 2HNT, 2HIN, 2HUE/ 00728 DATA SGOTO / 12, 2H , 2H , 2H , 2HGO, 2H T, 2HO / 00729 DATA SGOTOI / 13, 2H , 2H , 2H , 2HGO, 2H T, 2HO , 1HI/ 00730 DATA SGOTOP / 13, 2H , 2H , 2H , 2HGO, 2H T, 2HO , 1H(/ 00731 DATA SGUP1 / 57, 2H**, 2H**, 2H* , 2HTR, 2HAN, 2HSL, 2HAT, 2HOR 00732 1 , 2H H, 2HAS, 2H U, 2HSE, 2HD , 2HUP, 2H I, 2HTS 00733 1 , 2H A, 2HLL, 2HOT, 2HED, 2H S, 2HPA, 2HCE, 2H F 00734 1 , 2HOR, 2H T, 2HAB, 2HLE, 1HS/ 00735 DATA SGUP2 / 44, 2H**, 2H**, 2H* , 2HTR, 2HAN, 2HSL, 2HAT, 2HIO 00736 1 , 2HN , 2HMU, 2HST, 2H T, 2HER, 2HMI, 2HNA, 2HTE 00737 1 , 2H I, 2HMM, 2HED, 2HIA, 2HTE, 2HLY/ 00738 DATA SI / 1, 1HI/ !850626 00740 DATA SIF / 8, 2H , 2H , 2H , 2HIF/ 00742 DATA SIFP / 9, 2H , 2H , 2H , 2HIF, 1H(/ 00743 DATA SIFPN / 14, 2H , 2H , 2H , 2HIF, 2H(., 2HNO, 2HT./ 00744 DATA SLP / 1, 1H(/ !850625 00746 DATA SNE / 4, 2H.N, 2HE./ 00748 DATA SOR / 4, 2H.O, 2HR./ !850626 00750 DATA SPB / 2, 2H) / 00752 DATA SPGOTO / 8, 2H) , 2HGO, 2H T, 2HO / 00753 DATA SPNOT / 6, 2H(., 2HNO, 2HT./ !850626 00755 DATA SPTHEN / 6, 2H)T, 2HHE, 2HN / !850516 00756 DATA SRP / 1, 1H)/ 00758 DATA SRPCI / 4, 2H),, 2H I/ 00759 DATA SRTN / 12, 2H , 2H , 2H , 2HRE, 2HTU, 2HRN/ 00760 DATA SSPACR / 3, 2H. , 1H / 00761 DATA SSTOP / 15, 2H , 2H , 2H , 2HCA, 2HLL, 2H E, 2HXI, 1HT/ 00762 DATA STHEN / 5, 2HTH, 2HEN, 1H / !850516 00764 DATA STRUE / 6, 2H.T, 2HRU, 2HE. / !850625 00765 DATA SVER / 21, 2HFL, 2HEC, 2HS , 2HVE, 2HRS, 2HIO, 2HN , 2H86 00767 1 , 2H02, 2H14, 1H / 00768 ASSIGN 32757 TO I32758 00774 GO TO 32758 00774 32757 I32756=.TRUE. 00775 DOWHILE(((I32756)).OR.(.NOT.(DONE))) 00775 I32756=.FALSE. 00775 NOCALL=NOCALL+1 !ONE MORE CALL MADE TO OPENF 00776 CALL OPENF(NOCALL,DONE,SVER) !GET CMD LINE, OPEN FTN,FLL,FLX 00777 IF(.NOT.(DONE))THEN 00778 ENDFIL=.FALSE. 00779 MINCNT=0 !NUMBER OF WARNINGS 00780 MAJCNT=0 !NUMBER OF ERRORS 00781 LINENO=0 !INITIALIZE LINE # FOR FLX FILE 00782 I32755=.TRUE. 00783 DOWHILE(((I32755)).OR.(.NOT.(ENDFIL))) 00783 I32755=.FALSE. 00783 ASSIGN 32753 TO I32754 00784 GO TO 32754 00784 32753 ASSIGN 32751 TO I32752 00785 GO TO 32752 00785 32751 CONTINUE 00786 ENDDO 00786 CALL CLOSEF(MINCNT,MAJCNT) !CLOSE FLX,FTN,FLL FILES 00787 ENDIF 00788 ENDDO 00789 CALL EXFLE !MAO, 30-APR-80 00790 32750 CONTINUE 00791 CALL CPYSUB (SST,SFLX,USTART(1),ULEN(1)) 00795 CALL NEWNAM (SST(1),SST(2)) 00796 GO TO I32750 00797 32749 CONTINUE 00798 ASSIGN 32747 TO I32748 00802 GO TO 32748 00802 32747 IF(UTYPE(1).EQ.UEXP)THEN 00803 IF(FCSEXP)THEN 00810 ASSIGN 32745 TO I32746 00811 GO TO 32746 00811 32745 FCSEXP=.FALSE. !850625 00812 ELSE 00814 ASSIGN 32743 TO I32744 00814 GO TO 32744 00814 32743 CONTINUE 00814 ENDIF 00814 ELSE 00817 ASSIGN 32741 TO I32742 00822 GO TO 32742 00822 32741 CONTINUE 00823 ENDIF 00824 ASSIGN 32739 TO I32740 00825 GO TO 32740 00825 32739 GO TO I32749 00826 32738 CONTINUE 00827 TOP=TOP+4 00832 STACK(TOP)=ACSEQ 00833 STACK(TOP-1)=LINENO 00834 STACK(TOP-2)=0 00835 STACK(TOP-3)=0 00836 LEVEL=LEVEL+1 00837 ASSIGN 32737 TO I32748 00838 GO TO 32748 00838 32737 CONTINUE 00839 FCSEXP=.TRUE. !850625 00840 GO TO I32738 00842 32736 CONTINUE 00843 CONTNO=NEWNO(0) 00857 ASSIGN 32734 TO I32735 00858 GO TO 32735 00858 32734 CALL CPYSTR(SST,SDOST) 00859 CALL CATNUM(SST,CONTNO) 00860 CALL CATSTR(SST,SB) 00861 CALL CATSUB(SST,SFLX,USTART(1)+1,ULEN(1)-2) 00867 STNO=FLXNO 00868 FLXNO=0 00869 ASSIGN 32732 TO I32733 00870 GO TO 32733 00870 32732 CONTINUE 00871 ASSIGN 32731 TO I32740 00872 GO TO 32740 00872 32731 CONTINUE 00873 FINEDO=.FALSE. !850625 00874 GO TO I32736 00876 32730 CONTINUE 00877 TOP=TOP-2 00878 ASSIGN 32729 TO I32748 00879 GO TO 32748 00879 32729 CONTINUE 00880 ASSIGN 32727 TO I32728 00881 GO TO 32728 00881 32727 CALL CPYSTR(SST,SELSE) !850624 00882 ASSIGN 32726 TO I32733 00883 GO TO 32733 00883 32726 CONTINUE 00884 IF(NUNITS.EQ.1)THEN 00885 IF(UTYPE(1).EQ.UPINV)THEN 00886 ASSIGN 32724 TO I32725 00886 GO TO 32725 00886 32724 CONTINUE 00887 ELSE 00887 CALL CPYSUB(SST,SFLX,USTART(1),ULEN(1)) 00888 IF(.NOT.(STREQ(SST,SCONT)))THEN 00889 ASSIGN 32722 TO I32723 00889 GO TO 32723 00889 32722 CONTINUE 00889 ENDIF 00889 ENDIF 00890 ASSIGN 32720 TO I32721 00892 GO TO 32721 00892 32720 CONTINUE 00893 ELSE 00895 FINEIF=.TRUE. !850625 00897 ASSIGN 32718 TO I32719 00899 GO TO 32719 00899 32718 CONTINUE 00900 FINEIF=.FALSE. !850625 00901 ENDIF 00903 GO TO I32730 00904 32717 CONTINUE 00906 ASSIGN 32715 TO I32716 00908 GO TO 32716 00908 32715 ASSIGN 32713 TO I32714 00909 GO TO 32714 00909 32713 GO TO I32717 00910 32712 CONTINUE 00912 IF(CNDLVL.NE.0)THEN 00913 ERROR=404 !30JUN81MAO 00913 ELSE 00914 ASSIGN 32710 TO I32711 00915 GO TO 32711 00915 32710 ASSIGN 32709 TO I32714 00917 GO TO 32714 00917 32709 IF (ENDFIL) ERROR=25 00918 ENDPGM=.TRUE. 00919 IF(IMPSET)THEN 00921 CALL IMPCLS !840307MAO 00922 IMPSET=.FALSE. !840307MAO 00923 ENDIF 00924 ENDIF 00926 GO TO I32712 00927 32708 CONTINUE 00937 ASSIGN 32707 TO I32716 00939 GO TO 32716 00939 32707 ASSIGN 32705 TO I32706 00940 GO TO 32706 00940 32705 ASSIGN 32704 TO I32714 00941 GO TO 32714 00941 32704 BLKIF=BLKIF-1 !860423 00942 GO TO I32708 00943 32703 CONTINUE 00945 IF((TFORT).EQ.(EXTYPE))THEN 00947 ASSIGN 32702 TO I32714 00947 GO TO 32714 00947 32702 CONTINUE 00948 ELSEIF((TIF).EQ.(EXTYPE))THEN 00948 ASSIGN 32700 TO I32701 00948 GO TO 32701 00948 32700 CONTINUE 00949 ELSEIF((TUNLES).EQ.(EXTYPE))THEN 00949 ASSIGN 32698 TO I32699 00949 GO TO 32699 00949 32698 CONTINUE 00950 ELSEIF((TWHEN).EQ.(EXTYPE))THEN 00950 ASSIGN 32696 TO I32697 00950 GO TO 32697 00950 32696 CONTINUE 00951 ELSEIF((TWHILE).EQ.(EXTYPE))THEN 00951 ASSIGN 32694 TO I32695 00951 GO TO 32695 00951 32694 CONTINUE 00952 ELSEIF((TUNTIL).EQ.(EXTYPE))THEN 00952 ASSIGN 32692 TO I32693 00952 GO TO 32693 00952 32692 CONTINUE 00953 ELSEIF((TRWHIL).EQ.(EXTYPE))THEN 00953 ASSIGN 32690 TO I32691 00953 GO TO 32691 00953 32690 CONTINUE 00954 ELSEIF((TRUNTL).EQ.(EXTYPE))THEN 00954 ASSIGN 32688 TO I32689 00954 GO TO 32689 00954 32688 CONTINUE 00955 ELSEIF((TINVOK).EQ.(EXTYPE))THEN 00955 ASSIGN 32687 TO I32725 00955 GO TO 32725 00955 32687 CONTINUE 00956 ELSEIF((TCOND).EQ.(EXTYPE))THEN 00956 ASSIGN 32686 TO I32738 00956 GO TO 32738 00956 32686 CONTINUE 00957 ELSEIF((TSELCT).EQ.(EXTYPE))THEN 00957 ASSIGN 32684 TO I32685 00957 GO TO 32685 00957 32684 CONTINUE 00958 ELSEIF((TDO).EQ.(EXTYPE))THEN 00958 ASSIGN 32683 TO I32736 00958 GO TO 32736 00958 32683 CONTINUE 00959 ELSEIF((TIFTHN).EQ.(EXTYPE))THEN 00963 ASSIGN 32681 TO I32682 00963 GO TO 32682 00963 32681 CONTINUE 00964 ENDIF 00965 GO TO I32703 00966 32723 CONTINUE 00977 STNO=FLXNO !IF STMNT # ON FLX LINE, PUT IT ON THIS LINE 00978 CALL CPYSTR(SST,SB6) !PUT IN 6 BLANKS 00979 IF(UTYPE(1).EQ.UFORT)THEN 00980 J=1 00980 ELSE 00981 J=2 00981 ENDIF 00981 CALL CATSUB(SST,SFLX,USTART(J),ULEN(J)) !ADD ON FORTRAN LINE 00982 ASSIGN 32680 TO I32733 00983 GO TO 32733 00983 32680 GO TO I32723 00984 32701 CONTINUE 00985 IF(NUNITS.EQ.2.AND.UTYPE(2).EQ.UFORT)THEN 00990 ASSIGN 32679 TO I32714 00990 GO TO 32714 00990 32679 CONTINUE 00991 ELSE 00991 ASSIGN 32677 TO I32678 00991 GO TO 32678 00991 32677 CONTINUE 00991 ENDIF 00991 GO TO I32701 00993 32682 CONTINUE 00995 TOP=TOP+2 !860214 00996 STACK(TOP-1) = LINENO !860214 00997 STACK(TOP) = AELS77 !860214 00998 ASSIGN 32676 TO I32716 00999 GO TO 32716 00999 32676 ASSIGN 32675 TO I32714 01000 GO TO 32714 01000 32675 LEVEL=LEVEL+1 !860214 01001 BLKIF=BLKIF+1 !860423 01002 GO TO I32682 01003 32725 CONTINUE 01005 ASSIGN 32673 TO I32674 01006 GO TO 32674 01006 32673 ENTNO=STACK(PENT+1) !START OF PROCEDURE STMNT # 01007 RETNO=NEWNO(0) !WHERE TO RETURN FROM THIS CALL 01008 MAX=MAX-(1+OFFSET) 01009 STACK(MAX+1)=STACK(PENT+3) 01010 STACK(PENT+3)=MAX+1 01011 STACK(MAX+2)=LINENO 01012 IF (LONG.OR.COGOTO) STACK(MAX+3)=RETNO 01013 IF(COGOTO)THEN 01019 STACK(PENT-2)=STACK(PENT-2)+1 01020 CALL CPYSTR(SST,SB6I) 01021 CALL CATNUM(SST,ENTNO) 01022 CALL CATSTR(SST,SEQ) 01023 CALL CATNUM(SST,STACK(PENT-2)) 01024 ELSE 01026 CALL CPYSTR(SST,SASSN1) 01027 CALL CATNUM(SST,RETNO) 01028 CALL CATSTR(SST,SASSN2) 01029 CALL CATNUM(SST,ENTNO) !ASSIGN 'RETNO' TO I'ENTNO 01030 ENDIF 01031 STNO=FLXNO 01032 ASSIGN 32672 TO I32733 01033 GO TO 32733 01033 32672 GOTONO=ENTNO 01034 ASSIGN 32670 TO I32671 01035 GO TO 32671 01035 32670 NEXTNO=RETNO !NEXT STMNT #=RETURN PLACE FROM PROCEDURE 01036 GO TO I32725 01038 32742 CONTINUE 01040 IF(FCSEXP)THEN 01041 CALL CPYSTR(SST,SIFP) !850625 01043 CALL CATSTR(SST,STRUE) !850625 01044 CALL CATSTR(SST,SPTHEN) !850625 01045 ASSIGN 32669 TO I32733 01046 GO TO 32733 01046 32669 FCSEXP=.FALSE. !850625 01047 ELSE 01049 ASSIGN 32668 TO I32728 01050 GO TO 32728 01050 32668 CALL CPYSTR(SST,SELSE) !850625 01051 ASSIGN 32667 TO I32733 01052 GO TO 32733 01052 32667 CONTINUE 01053 ENDIF 01053 GO TO I32742 01054 32689 CONTINUE 01056 NOTFLG=.FALSE. 01057 ASSIGN 32666 TO I32691 01058 GO TO 32691 01058 32666 GO TO I32689 01059 32691 CONTINUE 01060 ASSIGN 32665 TO I32748 01062 GO TO 32748 01062 32665 CONTINUE 01063 TESTNO=NEWNO(0) !# ON IF(.NOT. 01064 TOPNO=NEWNO(0) !# AT TOP OF SCOPE 01065 ENDNO=NEWNO(0) !# PAST END OF LOOP 01066 GOTONO=TOPNO 01067 ASSIGN 32664 TO I32671 01068 GO TO 32671 01068 32664 STNO=TESTNO 01069 GOTONO=ENDNO 01070 ASSIGN 32662 TO I32663 01071 GO TO 32663 01071 32662 GSTNO=ENDNO 01072 ASSIGN 32660 TO I32661 01073 GO TO 32661 01073 32660 GGOTON=TESTNO 01074 ASSIGN 32658 TO I32659 01075 GO TO 32659 01075 32658 NEXTNO=TOPNO !NEXT STMNT #=TOPNO 01076 ASSIGN 32657 TO I32740 01114 GO TO 32740 01114 32657 CONTINUE 01115 GO TO I32691 01118 32685 CONTINUE 01119 ASSIGN 32656 TO I32748 01120 GO TO 32748 01120 32656 LEVEL=LEVEL+1 01121 L=(ULEN(1)-1)/NCHPWD+6 !PREPARE TO STORE EXPRESSION ON STACK 01122 TOP=TOP+L+1 01123 IF(TOP+SAFETY.LT.MAX)THEN 01124 STACK(TOP)=ASSEQ 01125 STACK(TOP-1)=LINENO 01126 STACK(TOP-2)=0 01127 STACK(TOP-3)=0 01128 STACK(TOP-4)=L 01129 STACK(TOP-L)=0 01130 CALL CATSUB(STACK(TOP-L),SFLX,USTART(1),ULEN(1)) !PUT ON STACK 01131 FCSEXP=.TRUE. !850625 01133 ELSE 01136 ASSIGN 32654 TO I32655 01136 GO TO 32655 01136 32654 CONTINUE 01136 ENDIF 01136 GO TO I32685 01137 32653 CONTINUE 01138 LEVEL=LEVEL-1 01139 ASSIGN 32652 TO I32748 01140 GO TO 32748 01140 32652 CONTINUE 01141 IF(FCSEXP)THEN 01148 FCSEXP = .FALSE. !no clauses at all !850625 01148 ELSE 01149 ASSIGN 32651 TO I32721 01149 GO TO 32721 01149 32651 CONTINUE 01149 ENDIF 01149 ASSIGN 32649 TO I32650 01151 GO TO 32650 01151 32649 GO TO I32653 01152 32648 CONTINUE 01153 ASSIGN 32647 TO I32748 01157 GO TO 32748 01157 32647 IF(UTYPE(1).EQ.UEXP)THEN 01158 IF(FCSEXP)THEN 01168 CALL CPYSTR(SST,SIFP) !850625 01169 FCSEXP=.FALSE. !850625 01170 ELSE 01172 ASSIGN 32646 TO I32728 01173 GO TO 32728 01173 32646 CALL CPYSTR(SST,SEIF) !850625 01174 CALL CATSTR(SST,SLP) !850625 01175 ENDIF 01176 CALL CATSUB(SST,SFLX,USTART(1),ULEN(1)) !850625 01177 CALL CATSTR(SST,SEQL) !850625 01178 I=STACK(TOP-4) !850625 01179 CALL CATSTR(SST,STACK(TOP-I)) !850625 01180 CALL CATSTR(SST,SPTHEN) !850625 01181 STNO=0 01182 ASSIGN 32645 TO I32733 01183 GO TO 32733 01183 32645 CONTINUE 01184 ELSE 01186 ASSIGN 32644 TO I32742 01191 GO TO 32742 01191 32644 CONTINUE 01192 ENDIF 01193 ASSIGN 32643 TO I32740 01194 GO TO 32740 01194 32643 GO TO I32648 01195 32706 CONTINUE 01196 ASSIGN 32642 TO I32748 01201 GO TO 32748 01201 32642 LEVEL=LEVEL-1 01202 TOP=TOP-2 01203 GO TO I32706 01204 32641 CONTINUE 01205 ASSIGN 32640 TO I32674 01206 GO TO 32674 01206 32640 IF(STACK(PENT+2).NE.0)THEN 01207 ERROR=26 01208 MLINE=STACK(PENT+2) 01209 ENTNO=NEWNO(0) 01210 ELSE 01212 ENTNO=STACK(PENT+1) 01213 STACK(PENT+2)=LINENO 01214 ENDIF 01215 ASSIGN 32639 TO I32748 01216 GO TO 32748 01216 32639 ASSIGN 32638 TO I32728 01217 GO TO 32728 01217 32638 NEXTNO=ENTNO 01218 ASSIGN 32637 TO I32728 01219 GO TO 32728 01219 32637 TOP=TOP+2 01220 STACK(TOP)=AGRET 01221 IF(SHORT.OR.FAKE)THEN 01222 STACK(TOP-1)=ENTNO !SHORT .T. AT LAMPF 01222 ELSE 01223 STACK(TOP-1)=STACK(PENT-1) 01223 ENDIF 01223 UTYPE(1)=0 01224 ASSIGN 32636 TO I32740 01225 GO TO 32740 01225 32636 GO TO I32641 01226 32699 CONTINUE 01227 IF(NUNITS.EQ.2.AND.UTYPE(2).EQ.UFORT)THEN 01233 CALL CPYSTR(SST,SIFPN) 01234 CALL CATSUB(SST,SFLX,USTART(1),ULEN(1)) 01235 CALL CATSTR(SST,SPB) 01236 CALL CATSUB(SST,SFLX,USTART(2),ULEN(2)) 01237 STNO=FLXNO 01238 ASSIGN 32635 TO I32733 01239 GO TO 32733 01239 32635 CONTINUE 01241 ELSE 01241 NOTFLG=.FALSE. 01242 ASSIGN 32634 TO I32678 01243 GO TO 32678 01243 32634 CONTINUE 01244 ENDIF 01244 GO TO I32699 01246 32693 CONTINUE 01247 NOTFLG=.FALSE. 01248 ASSIGN 32633 TO I32695 01249 GO TO 32695 01249 32633 GO TO I32693 01250 32697 CONTINUE 01251 TOP=TOP+2 01258 STACK(TOP-1)=LINENO 01259 STACK(TOP)=AELSE !STACK CMD TO LOOK FOR ELSE 01260 STNO=FLXNO 01268 FLXNO=0 01269 ASSIGN 32632 TO I32746 01274 GO TO 32746 01274 32632 CONTINUE 01275 ASSIGN 32631 TO I32740 01276 GO TO 32740 01276 32631 GO TO I32697 01277 32695 CONTINUE 01278 IF(FLXNO.NE.0)THEN 01282 LOOPNO=FLXNO 01283 FLXNO=0 01284 ELSEIF(NEXTNO.NE.0)THEN 01286 LOOPNO=NEXTNO 01287 NEXTNO=0 01288 ELSE 01290 LOOPNO=NEWNO(0) 01291 ENDIF 01293 ENDNO=NEWNO(0) 01294 GSTNO=ENDNO 01295 ASSIGN 32630 TO I32661 01296 GO TO 32661 01296 32630 GGOTON=LOOPNO 01297 ASSIGN 32629 TO I32659 01298 GO TO 32659 01298 32629 GOTONO=ENDNO 01299 STNO=LOOPNO 01300 ASSIGN 32628 TO I32663 01301 GO TO 32663 01301 32628 CONTINUE 01302 ASSIGN 32627 TO I32740 01312 GO TO 32740 01312 32627 CONTINUE 01313 GO TO I32695 01316 32740 CONTINUE 01317 IF(NUNITS.EQ.1)THEN 01323 ASSIGN 32626 TO I32719 01323 GO TO 32719 01323 32626 CONTINUE 01324 ELSEIF(UTYPE(2).EQ.UPINV)THEN 01324 ASSIGN 32625 TO I32725 01325 GO TO 32725 01325 32625 CONTINUE 01326 IF(EXTYPE.EQ.TIF.OR.EXTYPE.EQ.TUNLES)THEN 01327 ASSIGN 32624 TO I32721 01327 GO TO 32721 01327 32624 CONTINUE 01327 ENDIF 01327 ELSE 01335 CALL CPYSUB(SST,SFLX,USTART(2),ULEN(2)) !IS IT JUST "CONTINUE"? 01336 IF(.NOT.(STREQ(SST,SCONT)))THEN 01337 ASSIGN 32623 TO I32723 01337 GO TO 32723 01337 32623 CONTINUE 01337 ENDIF 01337 ENDIF 01344 GO TO I32740 01345 32674 CONTINUE 01346 IF(UTYPE(1).EQ.UPINV)THEN 01347 J=1 01347 ELSE 01348 J=2 01348 ENDIF 01348 CALL CPYSUB(SPINV,SFLX,USTART(J),ULEN(J)) 01349 IF(STREQ(SPINV,SDUM))THEN 01350 PENT=PDUMMY 01351 STACK(PENT+2)=0 01352 ELSE 01354 P=MAXSTK-HASH(SPINV,PRIME) 01355 FOUND=.FALSE. 01356 IF(.NOT.(STACK(P).EQ.0))THEN 01357 I32622=.TRUE. 01358 DOWHILE(((I32622)).OR.(.NOT.(STACK(P).EQ.0.OR.FOUND))) 01358 I32622=.FALSE. 01358 P=STACK(P) 01359 IF (STREQ(SPINV,STACK(P+4))) FOUND=.TRUE. 01360 ENDDO 01361 ENDIF 01362 IF(FOUND)THEN 01363 PENT=P 01363 ELSE 01364 TMAX=MAX-(4+OFFST2+(SPINV(1)+NCHPWD-1)/NCHPWD) 01365 IF(TMAX.LE.TOP+SAFETY)THEN 01366 PENT=PDUMMY 01367 STACK(PENT+2)=0 01368 ELSE 01370 MAX=TMAX 01371 PENT=MAX+OFFST2 01372 IF (LONG.OR.COGOTO) STACK(PENT-1)=NEWNO(0) 01373 IF (COGOTO) STACK(PENT-2)=0 01374 STACK(PENT)=0 01375 STACK(P)=PENT 01376 STACK(PENT+1)=NEWNO(0) 01377 IF(IMPSET)CALL IMPWRT(STACK(PENT+1),LINENO,FORTCL)!840814MAO 01379 STACK(PENT+2)=0 01381 STACK(PENT+3)=0 01382 CALL CPYSTR(STACK(PENT+4),SPINV) 01383 ENDIF 01384 ENDIF 01385 ENDIF 01386 GO TO I32674 01387 32678 CONTINUE 01388 STNO=FLXNO 01392 FLXNO=0 01393 ASSIGN 32621 TO I32746 01400 GO TO 32746 01400 32621 FINEIF=.TRUE. 01401 ASSIGN 32620 TO I32740 01403 GO TO 32740 01403 32620 CONTINUE 01404 FINEIF=.FALSE. 01405 GO TO I32678 01407 32728 CONTINUE 01408 IF(NEXTNO.NE.0)THEN 01413 CALL PUTNUM(SFORCE,NEXTNO) 01418 CALL PUT(LINENO,SFORCE,FORTCL) 01419 NEXTNO=0 01421 ENDIF 01422 GO TO I32728 01423 32716 CONTINUE 01424 ASSIGN 32619 TO I32728 01429 GO TO 32728 01429 32619 IF(STNO.NE.0)THEN 01430 NEXTNO=STNO 01431 ASSIGN 32618 TO I32728 01432 GO TO 32728 01432 32618 STNO=0 01433 ENDIF 01434 IF(FLXNO.NE.0)THEN 01435 NEXTNO=FLXNO 01436 ASSIGN 32617 TO I32728 01437 GO TO 32728 01437 32617 FLXNO=0 01438 ENDIF 01439 GO TO I32716 01440 32616 CONTINUE 01464 STNO=STACK(TOP-1) 01470 ASSIGN 32614 TO I32615 01471 GO TO 32615 01471 32614 CONTINUE 01472 TOP=TOP-2 01473 GO TO I32616 01474 32721 CONTINUE 01486 ASSIGN 32613 TO I32728 01490 GO TO 32728 01490 32613 CALL CPYSTR(SST,SENDIF) !850516 01491 ASSIGN 32612 TO I32733 01492 GO TO 32733 01492 32612 GO TO I32721 01493 32611 CONTINUE 01495 GOTONO=STACK(TOP-1) 01499 ASSIGN 32610 TO I32671 01500 GO TO 32671 01500 32610 TOP=TOP-2 01501 GO TO I32611 01502 32609 CONTINUE 01550 STNO=0 01551 CALL CPYSTR(SST,SGOTOI) 01557 IF (LONG.OR.COGOTO) SST(1)=SST(1)-1 01558 CALL CATNUM(SST,STACK(TOP-1)) !GOTO I# 01559 IF(FAKE)THEN 01560 CALL CATSTR(SST,SCP) 01561 CALL CATNUM(SST,STACK(TOP-1)) 01562 CALL CATSTR(SST,SRP) 01563 ENDIF 01564 ASSIGN 32608 TO I32733 01565 GO TO 32733 01565 32608 CONTINUE 01566 TOP=TOP-2 01567 GO TO I32609 01568 32607 CONTINUE 01569 ASSIGN 32606 TO I32728 01574 GO TO 32728 01574 32606 NEXTNO=STACK(TOP-1) 01575 TOP=TOP-2 01576 GO TO I32607 01577 32655 CONTINUE 01578 CALL PUT(0,SGUP1,ERRCL) 01579 CALL PUT(0,SGUP2,ERRCL) 01580 CALL CLOSEF(MINCNT,-1) 01581 CALL EXFLE !MAO, 30-APR-80 01582 GO TO I32655 01583 32605 CONTINUE 01593 CALL CPYSUB (SST,SFLX,USTART(1),ULEN(1)) 01597 CALL OPNINC (SST(1),SST(2),ERROR) 01598 IF (ERROR.NE.0) ERROR=ERROR+300 01599 GO TO I32605 01600 32758 CONTINUE 01601 CALL LAMPFI(ALECS,CHC,CINLIN) !20-FEB-80 01605 NOCALL=0 !# OF TIMES OPENF HAS BEEN CALLED 01607 PARAM1=NCHPWD !# OF CHARACTERS PER INTEGER WORD 01608 PARAM2=CHZERO 01609 PARAM3=CHSPAC 01610 PARAM4=CHC !COMMENT CHARACTER 01611 PARAM5=CINLIN !IN-LINE COMMENT CHAR !25-JAN-80 01612 BLN=0 01613 WWIDTH=LWIDTH-18 !11-SEP-75, 830307 ADD FORT LINE # 01614 REFNO=(WWIDTH-6)/7 !11-SEP-75 !830311 01615 IF(SHORT.OR.FAKE)THEN 01617 OFFSET=1 01618 OFFST2=1 01619 ELSEIF(COGOTO)THEN 01621 OFFSET=2 01622 OFFST2=3 01623 ELSE 01625 OFFSET=2 01626 OFFST2=3 01627 ENDIF 01629 NOTFLG=.TRUE. 01630 ERLST=.FALSE. 01631 IMPSET=.FALSE. !840307MAO 01633 FINEIF=.FALSE. !850516 01635 FINEDO=.FALSE. !850625 01636 GO TO I32758 01638 32650 CONTINUE 01639 TOPTYP=STACK(TOP) 01640 IF((ASSEQ).EQ.(TOPTYP))THEN 01642 TOP=TOP-STACK(TOP-4)-1 01642 ELSEIF((ACSEQ).EQ.(TOPTYP))THEN 01643 TOP=TOP-4 01643 ELSEIF((AGGOTO).EQ.(TOPTYP))THEN 01644 TOP=TOP-2 01644 ELSEIF((AGCONT).EQ.(TOPTYP))THEN 01645 TOP=TOP-2 01645 ELSEIF((AFSEQ).EQ.(TOPTYP))THEN 01646 TOP=TOP-2 01646 ELSEIF((AELSE).EQ.(TOPTYP))THEN 01647 TOP=TOP-2 01647 ELSEIF((AELS77).EQ.(TOPTYP))THEN 01649 TOP=TOP-2 !860214 01649 ELSEIF((AGSTNO).EQ.(TOPTYP))THEN 01651 TOP=TOP-2 01651 ELSEIF((ATSEQ).EQ.(TOPTYP))THEN 01652 TOP=TOP-1 01652 ELSEIF((AMSEQ).EQ.(TOPTYP))THEN 01653 TOP=TOP-1 01653 ELSEIF((AGRET).EQ.(TOPTYP))THEN 01654 TOP=TOP-2 01654 ENDIF 01655 GO TO I32650 01656 32754 CONTINUE 01657 DUMMY=NEWNO(SEEDNO) !INITIALIZE STMNT # GENERATOR 01660 ENDPGM=.FALSE. 01661 MAX=MAXSTK-(PRIME+OFFSET+3) 01662 PDUMMY=MAX+OFFSET 01663 DO I=MAX,MAXSTK 01664 STACK(I)=0 01664 ENDDO 01664 TOP=1 !START OF STACK 01665 STACK(TOP)=AMSEQ !INITIAL CMD: LOOK FOR FLECS MAIN LINE OR FORT 01666 ERROR=0 01667 FIRST=.TRUE. !THIS IS FIRST READ ON THIS FILE 01668 NOPGM=.FALSE. 01669 NEXTNO=0 !STMNT # FOR NEXT STMNT PUT IN FTN FILE 01670 SOURCE=READ !GET INPUT FROM FILE 01671 LEVEL=0 01672 LSTLEV=0 01673 PASFLG=.TRUE. !30JUN81MAO 01674 CNDLVL=0 !30JUN81MAO 01675 OFFLVL=0 !30JUN81MAO 01676 BLKIF=0 !860423 01677 FCSEXP=.FALSE. !850625 01679 NUMLIN=0 !NO FORT LINES YET !830307 01682 GO TO I32754 01688 32604 CONTINUE 01689 IF((DPAGE).EQ.(DTYPE))THEN 01694 ASSIGN 32602 TO I32603 01694 GO TO 32603 01694 32602 CONTINUE 01695 ELSEIF((DINCL).EQ.(DTYPE))THEN 01695 ASSIGN 32601 TO I32605 01695 GO TO 32605 01695 32601 CONTINUE 01696 ELSEIF((DPIF).EQ.(DTYPE))THEN 01696 ASSIGN 32599 TO I32600 01696 GO TO 32600 01696 32599 CONTINUE 01697 ELSEIF((DPUNL).EQ.(DTYPE))THEN 01697 ASSIGN 32597 TO I32598 01697 GO TO 32598 01697 32597 CONTINUE 01698 ELSEIF((DPEND).EQ.(DTYPE))THEN 01698 ASSIGN 32595 TO I32596 01698 GO TO 32596 01698 32595 CONTINUE 01699 ELSEIF((DNAME).EQ.(DTYPE))THEN 01699 ASSIGN 32594 TO I32750 01699 GO TO 32750 01699 32594 CONTINUE 01700 ELSEIF((DIMP).EQ.(DTYPE))THEN 01701 ASSIGN 32592 TO I32593 01701 GO TO 32593 01701 32592 CONTINUE 01702 ENDIF 01703 GO TO I32604 01704 32593 CONTINUE 01706 CALL IMPOPN (IMPSET,LINENO,FORTCL,ERRCL,MAJCNT) !840307MAO 01710 GO TO I32593 01711 32596 CONTINUE 01713 ASSIGN 32591 TO I32716 01714 GO TO 32716 01714 32591 IF(CNDLVL.EQ.0)THEN 01715 ERROR=401 !extra .PASSEND 01715 ELSE 01716 IF (CNDLVL.EQ.OFFLVL) PASFLG=.TRUE. !back on 01717 CNDLVL=CNDLVL-1 01718 ENDIF 01719 GO TO I32596 01720 32600 CONTINUE 01721 ASSIGN 32590 TO I32716 01723 GO TO 32716 01723 32590 CNDLVL=CNDLVL+1 !one more level of conditional 01724 IF(PASFLG)THEN 01725 CALL CPYSUB (SST,SFLX,USTART(1),ULEN(1)) !get the name 01729 IF(SST(1).GT.6)THEN 01730 SST(1)=6 01731 ERROR=402 01732 ENDIF 01733 IF (SST(1).LT.1) ERROR=403 !no name given! 01734 IF(ERROR.EQ.0)THEN 01735 I=1 01736 FOUND=.FALSE. 01737 DOWHILE(.NOT.(I.GT.COND .OR. FOUND)) 01738 FOUND=STREQ (SST,CNDVAL(1,I)) 01739 I=I+1 01740 ENDDO 01741 IF(.NOT.(NOTFLG)) FOUND=.NOT.FOUND !invert for .PASSUNLESS 01743 IF(.NOT.(FOUND))THEN 01745 PASFLG=.FALSE. 01746 OFFLVL=CNDLVL 01747 ENDIF 01748 ENDIF 01749 ENDIF 01750 GO TO I32600 01751 32598 CONTINUE 01752 NOTFLG=.FALSE. !signal really PASSUNLESS 01753 ASSIGN 32589 TO I32600 01754 GO TO 32600 01754 32589 NOTFLG=.TRUE. !reset to default value 01755 GO TO I32598 01756 32752 CONTINUE 01757 I32588=.TRUE. 01758 DOWHILE(((I32588)).OR.(.NOT.(ENDPGM))) 01758 I32588=.FALSE. 01758 IF(TOP+SAFETY.GT.MAX)THEN 01759 ASSIGN 32587 TO I32655 01759 GO TO 32655 01759 32587 CONTINUE 01759 ENDIF 01759 ACTION=STACK(TOP) !ON FIRST PASS=AMSEQ 01760 IF((AGGOTO).EQ.(ACTION))THEN 01762 ASSIGN 32586 TO I32611 01762 GO TO 32611 01762 32586 CONTINUE 01763 ELSEIF((AGRET).EQ.(ACTION))THEN 01763 ASSIGN 32585 TO I32609 01763 GO TO 32609 01763 32585 CONTINUE 01764 ELSEIF((AGCONT).EQ.(ACTION))THEN 01764 ASSIGN 32584 TO I32616 01764 GO TO 32616 01764 32584 CONTINUE 01765 ELSEIF((AGSTNO).EQ.(ACTION))THEN 01765 ASSIGN 32583 TO I32607 01765 GO TO 32607 01765 32583 CONTINUE 01766 ELSEIF((AGENDI).EQ.(ACTION))THEN 01767 ASSIGN 32582 TO I32721 01768 GO TO 32721 01768 32582 TOP=TOP-1 !850516 01769 ELSE 01778 CALL ANALYZ !GET INPUT AND FIGURE OUT WHAT NEEDS DOING 01779 IF((AELS77).EQ.(ACTION))THEN 01782 IF((TDIR).EQ.(CLASS))THEN 01784 ASSIGN 32581 TO I32604 01784 GO TO 32604 01784 32581 CONTINUE 01785 ELSEIF((TEXEC).EQ.(CLASS))THEN 01785 ASSIGN 32580 TO I32703 01785 GO TO 32703 01785 32580 CONTINUE 01786 ELSEIF((TFIN).EQ.(CLASS))THEN 01786 ERROR=5 !860214 01786 ELSEIF((TEND).EQ.(CLASS))THEN 01790 ERROR=1 !860214 01790 ELSEIF((TELSE).EQ.(CLASS))THEN 01791 ASSIGN 32579 TO I32717 01791 GO TO 32717 01791 32579 CONTINUE 01792 ELSEIF((TTO).EQ.(CLASS))THEN 01792 ERROR=13 !860214 01792 ELSEIF((TCEXP).EQ.(CLASS))THEN 01793 ERROR=19 !860214 01793 ELSEIF((TOFF).EQ.(CLASS))THEN 01794 CONTINUE !860214 01794 ELSEIF((TELSIF).EQ.(CLASS))THEN 01795 ASSIGN 32578 TO I32717 01795 GO TO 32717 01795 32578 CONTINUE 01796 ELSEIF((TENDIF).EQ.(CLASS))THEN 01796 ASSIGN 32577 TO I32708 01796 GO TO 32708 01796 32577 CONTINUE 01797 ENDIF 01797 ELSEIF((AFSEQ).EQ.(ACTION))THEN 01800 IF((TDIR).EQ.(CLASS))THEN 01802 ASSIGN 32576 TO I32604 01802 GO TO 32604 01802 32576 CONTINUE 01803 ELSEIF((TEXEC).EQ.(CLASS))THEN 01803 ASSIGN 32575 TO I32703 01803 GO TO 32703 01803 32575 CONTINUE 01804 ELSEIF((TFIN).EQ.(CLASS))THEN 01804 ASSIGN 32574 TO I32706 01804 GO TO 32706 01804 32574 CONTINUE 01805 ELSEIF((TEND).EQ.(CLASS))THEN 01808 ERROR=1 01808 ELSEIF((TELSE).EQ.(CLASS))THEN 01809 ERROR=10 01809 ELSEIF((TTO).EQ.(CLASS))THEN 01810 ERROR=13 01810 ELSEIF((TCEXP).EQ.(CLASS))THEN 01811 ERROR=19 01811 ELSEIF((TOFF).EQ.(CLASS))THEN 01812 CONTINUE !30JUN81MAO 01812 ELSEIF((TELSIF).EQ.(CLASS))THEN 01814 ERROR=5 !860214 01814 ELSEIF((TENDIF).EQ.(CLASS))THEN 01815 ERROR=5 !860214 01815 ENDIF 01817 ELSEIF((AMSEQ).EQ.(ACTION))THEN 01819 IF((TDIR).EQ.(CLASS))THEN 01821 ASSIGN 32573 TO I32604 01821 GO TO 32604 01821 32573 CONTINUE 01822 ELSEIF((TEXEC).EQ.(CLASS))THEN 01822 ASSIGN 32572 TO I32703 01822 GO TO 32703 01822 32572 CONTINUE 01823 ELSEIF((TEND).EQ.(CLASS))THEN 01823 IF(NOPGM)THEN 01824 ENDPGM=.TRUE. 01824 ELSE 01825 ASSIGN 32571 TO I32712 01825 GO TO 32712 01825 32571 CONTINUE 01825 ENDIF 01825 ELSEIF((TFIN).EQ.(CLASS))THEN 01827 ERROR=5 01827 ELSEIF((TELSE).EQ.(CLASS))THEN 01831 ERROR=8 01831 ELSEIF((TTO).EQ.(CLASS))THEN 01832 STACK(TOP)=ATSEQ !NOTE TOP NOT SHIFTED!!-->ONLY PROC DFN LEGAL 01833 ASSIGN 32570 TO I32641 01834 GO TO 32641 01834 32570 CONTINUE 01836 ELSEIF((TCEXP).EQ.(CLASS))THEN 01836 ERROR=17 01836 ELSEIF((TOFF).EQ.(CLASS))THEN 01837 CONTINUE !30JUN81MAO 01837 ELSEIF((TELSIF).EQ.(CLASS))THEN 01839 ERROR=5 !860214 01839 ELSEIF((TENDIF).EQ.(CLASS))THEN 01840 ERROR=5 !860214 01840 ENDIF 01842 ELSEIF((ASSEQ).EQ.(ACTION))THEN 01844 IF((TDIR).EQ.(CLASS))THEN 01846 ASSIGN 32569 TO I32604 01846 GO TO 32604 01846 32569 CONTINUE 01847 ELSEIF((TCEXP).EQ.(CLASS))THEN 01847 ASSIGN 32568 TO I32648 01847 GO TO 32648 01847 32568 CONTINUE 01848 ELSEIF((TFIN).EQ.(CLASS))THEN 01848 ASSIGN 32567 TO I32653 01848 GO TO 32653 01848 32567 CONTINUE 01849 ELSEIF((TEND).EQ.(CLASS))THEN 01852 ERROR=3 01852 ELSEIF((TELSE).EQ.(CLASS))THEN 01853 ERROR=12 01853 ELSEIF((TTO).EQ.(CLASS))THEN 01854 ERROR=15 01854 ELSEIF((TEXEC).EQ.(CLASS))THEN 01855 ERROR=23 01855 ELSEIF((TOFF).EQ.(CLASS))THEN 01856 CONTINUE !30JUN81MAO 01856 ELSEIF((TELSIF).EQ.(CLASS))THEN 01858 ERROR=5 !860214 01858 ELSEIF((TENDIF).EQ.(CLASS))THEN 01859 ERROR=5 !860214 01859 ENDIF 01861 ELSEIF((ACSEQ).EQ.(ACTION))THEN 01863 IF((TDIR).EQ.(CLASS))THEN 01865 ASSIGN 32566 TO I32604 01865 GO TO 32604 01865 32566 CONTINUE 01866 ELSEIF((TCEXP).EQ.(CLASS))THEN 01866 ASSIGN 32565 TO I32749 01866 GO TO 32749 01866 32565 CONTINUE 01867 ELSEIF((TFIN).EQ.(CLASS))THEN 01867 ASSIGN 32564 TO I32653 01867 GO TO 32653 01867 32564 CONTINUE 01868 ELSEIF((TEND).EQ.(CLASS))THEN 01871 ERROR=2 01871 ELSEIF((TELSE).EQ.(CLASS))THEN 01872 ERROR=11 01872 ELSEIF((TTO).EQ.(CLASS))THEN 01873 ERROR=14 01873 ELSEIF((TEXEC).EQ.(CLASS))THEN 01874 ERROR=22 01874 ELSEIF((TOFF).EQ.(CLASS))THEN 01875 CONTINUE !30JUN81MAO 01875 ELSEIF((TELSIF).EQ.(CLASS))THEN 01877 ERROR=5 !860214 01877 ELSEIF((TENDIF).EQ.(CLASS))THEN 01878 ERROR=5 !860214 01878 ENDIF 01880 ELSEIF((AELSE).EQ.(ACTION))THEN 01882 IF((TDIR).EQ.(CLASS))THEN 01884 ASSIGN 32563 TO I32604 01884 GO TO 32604 01884 32563 CONTINUE 01885 ELSEIF((TELSE).EQ.(CLASS))THEN 01885 ASSIGN 32562 TO I32730 01885 GO TO 32730 01885 32562 CONTINUE 01886 ELSEIF((TEND).EQ.(CLASS))THEN 01886 ERROR=4 01886 ELSEIF((TFIN).EQ.(CLASS))THEN 01887 ERROR=7 01887 ELSEIF((TTO).EQ.(CLASS))THEN 01891 ERROR=16 01891 ELSEIF((TCEXP).EQ.(CLASS))THEN 01892 ERROR=20 01892 ELSEIF((TEXEC).EQ.(CLASS))THEN 01893 ERROR=24 01893 ELSEIF((TOFF).EQ.(CLASS))THEN 01894 CONTINUE !30JUN81MAO 01894 ELSEIF((TELSIF).EQ.(CLASS))THEN 01896 ERROR=5 !860214 01896 ELSEIF((TENDIF).EQ.(CLASS))THEN 01897 ERROR=5 !860214 01897 ENDIF 01899 ELSEIF((ATSEQ).EQ.(ACTION))THEN 01901 IF((TDIR).EQ.(CLASS))THEN 01903 ASSIGN 32561 TO I32604 01903 GO TO 32604 01903 32561 CONTINUE 01904 ELSEIF((TTO).EQ.(CLASS))THEN 01904 ASSIGN 32560 TO I32641 01904 GO TO 32641 01904 32560 CONTINUE 01905 ELSEIF((TEND).EQ.(CLASS))THEN 01905 ASSIGN 32559 TO I32712 01905 GO TO 32712 01905 32559 CONTINUE 01906 ELSEIF((TFIN).EQ.(CLASS))THEN 01906 ERROR=6 01906 ELSEIF((TELSE).EQ.(CLASS))THEN 01910 ERROR=9 01910 ELSEIF((TCEXP).EQ.(CLASS))THEN 01911 ERROR=18 01911 ELSEIF((TEXEC).EQ.(CLASS))THEN 01912 ERROR=21 01912 ELSEIF((TOFF).EQ.(CLASS))THEN 01913 CONTINUE !30JUN81MAO 01913 ELSEIF((TELSIF).EQ.(CLASS))THEN 01915 ERROR=5 !860214 01915 ELSEIF((TENDIF).EQ.(CLASS))THEN 01916 ERROR=5 !860214 01916 ENDIF 01918 ENDIF 01920 IF(.NOT.(NOPGM .OR. CLASS.EQ.TOFF)) CALL LIST !30JUN81MAO 01921 ENDIF 01923 ENDDO 01924 GO TO I32752 01925 32719 CONTINUE 01926 IF(FINEIF)THEN 01928 TOP=TOP+1 !850516 01929 STACK(TOP) = AGENDI !850516 01930 ENDIF 01931 TOP=TOP+2 01939 STACK(TOP-1)=LINENO 01940 STACK(TOP)=AFSEQ 01941 LEVEL=LEVEL+1 01942 GO TO I32719 01943 32735 CONTINUE 01945 TOP=TOP+2 01946 STACK(TOP-1)=CONTNO 01947 STACK(TOP)=AGCONT 01948 GO TO I32735 01949 32659 CONTINUE 01952 TOP=TOP+2 01953 STACK(TOP-1)=GGOTON 01954 STACK(TOP)=AGGOTO 01955 GO TO I32659 01956 32661 CONTINUE 01959 TOP=TOP+2 01960 STACK(TOP-1)=GSTNO 01961 STACK(TOP)=AGSTNO 01962 GO TO I32661 01963 32615 CONTINUE 01965 ASSIGN 32558 TO I32728 01966 GO TO 32728 01966 32558 CONTINUE 01967 CALL PUTNUM(SFORCE,STNO) 01971 CALL PUT(LINENO,SFORCE,FORTCL) 01972 STNO=0 01974 GO TO I32615 01975 32714 CONTINUE 01976 CALL CPYSTR (SST,SFLX) !26JUN81MAO 01980 CALL GETCH (SST(2),1,I) !# IN COL 1? !26-JUN-81(MAO) 01981 IF (I.EQ.POUND)CALL PUTCH(SST(2),1,CHSPAC) !BLANK OUT !26JUN81MAO 01982 IF(NEXTNO.EQ.0)THEN 01984 CALL PUT(LINENO,SST,FORTCL) !26JUN81MAO 01984 ELSEIF(FLXNO.NE.0.OR.PASS)THEN 01985 ASSIGN 32557 TO I32728 01986 GO TO 32728 01986 32557 CALL PUT(LINENO,SST,FORTCL) !26JUN81MAO 01987 ELSE 01989 CALL PUTNUM(SST,NEXTNO) 01996 CALL PUT(LINENO,SST,FORTCL) 01997 NEXTNO=0 01999 ENDIF 02001 GO TO I32714 02002 32744 CONTINUE 02004 ASSIGN 32556 TO I32728 02005 GO TO 32728 02005 32556 CALL CPYSTR(SST,SEIF) !850625 02006 CALL CATSUB(SST,SFLX,USTART(1),ULEN(1)) !850625 02007 CALL CATSTR(SST,STHEN) !850625 02008 ASSIGN 32555 TO I32733 02009 GO TO 32733 02009 32555 GO TO I32744 02010 32671 CONTINUE 02012 CALL CPYSTR(SPUTGO,SGOTO) 02018 CALL CATNUM(SPUTGO,GOTONO) 02019 IF(NEXTNO.NE.0)THEN 02020 CALL PUTNUM(SPUTGO,NEXTNO) 02021 NEXTNO=0 02022 ENDIF 02023 CALL PUT(LINENO,SPUTGO,FORTCL) 02024 GO TO I32671 02026 32663 CONTINUE 02028 IF(NOTFLG)THEN 02038 CALL CPYSTR(SST,SIFPN) 02038 ELSE 02039 CALL CPYSTR(SST,SIF) 02039 ENDIF 02039 CALL CATSUB(SST,SFLX,USTART(1),ULEN(1)) 02040 IF(NOTFLG)THEN 02041 CALL CATSTR(SST,SPGOTO) 02041 ELSE 02042 CALL CATSTR(SST,SBGOTO) 02042 ENDIF 02042 CALL CATNUM(SST,GOTONO) 02043 ASSIGN 32554 TO I32733 02044 GO TO 32733 02044 32554 CONTINUE 02045 NOTFLG=.TRUE. 02046 GO TO I32663 02047 32746 CONTINUE 02050 IF(NOTFLG)THEN 02054 CALL CPYSTR(SST,SIF) !850516 02054 ELSE 02055 CALL CPYSTR(SST,SIFPN) !850516 02055 ENDIF 02055 CALL CATSUB(SST,SFLX,USTART(1),ULEN(1)) !850516 02056 IF(NOTFLG)THEN 02057 CALL CATSTR(SST,STHEN) !850516 02057 ELSE 02058 CALL CATSTR(SST,SPTHEN) !850516 02058 ENDIF 02058 ASSIGN 32553 TO I32733 02059 GO TO 32733 02059 32553 NOTFLG=.TRUE. !assume IF !850516 02060 GO TO I32746 02061 32603 CONTINUE 02063 CALL NEWPG 02067 GO TO I32603 02068 32733 CONTINUE 02069 IF(.NOT.(NEXTNO.EQ.0))THEN 02070 IF(STNO.EQ.0)THEN 02071 STNO=NEXTNO 02072 NEXTNO=0 02073 ELSE 02075 ASSIGN 32552 TO I32728 02075 GO TO 32728 02075 32552 CONTINUE 02075 ENDIF 02075 ENDIF 02076 IF(.NOT.(STNO.EQ.0))THEN 02077 CALL PUTNUM(SST,STNO) 02082 STNO=0 02084 ENDIF 02085 IF(SST(1).LE.72)THEN 02089 CALL PUT(LINENO,SST,FORTCL) 02089 ELSE 02090 S = SST(1) !860212 02102 DOWHILE(S.GT.0 .AND. SSTB(S+2).NE.1H!) 02104 S=S-1 !860212 02104 ENDDO 02104 JJ=SST(1) !save value !860212 02105 IF (S.GT.1) SST(1) = S-1 !860212 02106 IF(SST(1).LE.72)THEN 02110 CALL PUT(LINENO,SST,FORTCL) !860212 02110 ELSE 02111 CALL CPYSUB (SLIST,SST,1,72) 02112 CALL PUT(LINENO,SLIST,FORTCL) 02113 S=73 02114 L=66 02115 I32551=.TRUE. 02116 DOWHILE(((I32551)).OR.(.NOT.(S.GT.SST(1)))) 02116 I32551=.FALSE. 02116 IF(S+L-1.GT.SST(1)) L=SST(1)-S+1 02117 CALL CPYSTR(SLIST,SB5I1) 02118 CALL CATSUB(SLIST,SST,S,L) 02119 CALL PUT(LINENO,SLIST,FORTCL) 02120 IF(.NOT.(CNTALL)) NUMLIN=NUMLIN-1 !USUALLY DONT COUNT !830307 02121 S=S+66 02122 ENDDO 02123 ENDIF 02124 SST(1) = JJ !put back original length !860212 02125 ENDIF 02126 GO TO I32733 02127 32550 CONTINUE 02128 LL=0 02129 LR=STACK(LP) 02130 DOWHILE(.NOT.(LR.EQ.0)) 02131 LT=STACK(LR) 02132 STACK(LR)=LL 02133 LL=LR 02134 LR=LT 02135 ENDDO 02136 STACK(LP)=LL 02137 GO TO I32550 02138 32748 CONTINUE 02139 IF(FLXNO.NE.0)THEN 02140 ASSIGN 32549 TO I32728 02141 GO TO 32728 02141 32549 NEXTNO=FLXNO 02142 FLXNO=0 02143 ENDIF 02144 GO TO I32748 02145 32711 CONTINUE 02146 P=MAX 02147 STACK(MAX)=0 02148 ITEMP=MAXSTK-PRIME+1 02149 DO I=ITEMP,MAXSTK 02150 IF(.NOT.(STACK(I).EQ.0))THEN 02151 STACK(P)=STACK(I) 02152 I32548=.TRUE. 02153 DOWHILE(((I32548)).OR.(.NOT.(STACK(P).EQ.0))) 02153 I32548=.FALSE. 02153 P=STACK(P) 02154 LP=P+3 02155 ASSIGN 32547 TO I32550 02156 GO TO 32550 02156 32547 CONTINUE 02157 ENDDO 02157 ENDIF 02158 ENDDO 02159 Q=MAX-1 02160 STACK(Q)=0 02161 DOWHILE(.NOT.(STACK(MAX).EQ.0)) 02162 P=STACK(MAX) 02163 STACK(MAX)=STACK(P) 02164 QM=Q 02165 QP=STACK(QM) 02166 INSERT=.FALSE. 02167 DOWHILE(.NOT.(INSERT)) 02168 IF(QP.EQ.0)THEN 02170 INSERT=.TRUE. 02170 ELSEIF(STRLT(STACK(P+4),STACK(QP+4)))THEN 02171 INSERT=.TRUE. 02171 ELSE 02172 QM=QP 02173 QP=STACK(QM) 02174 ENDIF 02176 ENDDO 02177 STACK(P)=QP 02178 STACK(QM)=P 02179 ENDDO 02180 PTABLE=STACK(Q) 02181 GO TO I32711 02182 END 02183