C----------------------------------------------------------------------- C 27-JUN-85 (MAO) This version of the MAIN routine for FLECS generates C FORTRAN II code only. IE. it generates GOTOs rather C than IF-THEN-ELSEs. A new version of this routine C exists and generates F77 code. C C SAVE THIS FILE FOR FUTURE REFERENCE!!!!!!!!!!!!!!!!!!!!!!!!!!!! C C----------------------------------------------------------------------- PROGRAM FLECS 00085 INTEGER NUMLIN !830307 MAO 00169 LOGICAL CNTALL !830307 MAO 00170 COMMON/FLINE/CNTALL,NUMLIN 00171 INTEGER DTYPE !22-JUN-81 (MAO) 00173 COMMON/DIR/DTYPE !22-JUN-81 (MAO) 00174 LOGICAL PASFLG !30JUN81MAO 00176 INTEGER CNDLVL !30JUN81MAO 00177 INTEGER OFFLVL !30JUN81MAO 00178 INTEGER COND !30JUN81MAO 00179 INTEGER CNDVAL !30JUN81MAO 00180 COMMON/COND/PASFLG,CNDLVL,OFFLVL,COND,CNDVAL(4,10) !30JUN81MAO 00181 INTEGER POUND !26-JUN-81MAO 00186 INTEGER TDIR !22-JUN-81MAO 00187 INTEGER TOFF !30JUN81MAO 00188 INTEGER DPAGE !22-JUN-81MAO 00189 INTEGER DPIF,DPUNL,DPEND !30JUN81MAO 00190 INTEGER DNAME !30JUN81MAO 00191 INTEGER DINCL !29-JUN-81MAO 00192 INTEGER UDIR !29-JUN-81MAO 00193 INTEGER DIMP !840307MAO 00194 INTEGER ACSEQ , ACTION, AELSE , AFSEQ , AGCONT, AGGOTO 00195 INTEGER AGRET , AGSTNO, AMSEQ ,ASSEQ , ATSEQ 00196 INTEGER BLN , NOCALL, CHC , CHSPAC, CHZERO 00197 INTEGER CINLIN !25-JAN-80 00198 INTEGER CLASS , CONTNO, DUMMY , ELSNO , ENDNO , ENTNO 00199 INTEGER ERRCL , ERROR , ERRSTK, ERSTOP, EXTYPE, FLXNO 00200 INTEGER FORTCL, GGOTON, GOTONO, GSTNO , HASH , HOLDNO 00201 INTEGER I , ITEMP , J , L , LEVEL , LINENO 00202 INTEGER LL , LP , LR , LT 00203 INTEGER LISTCL, LOOPNO, LSTLEV, LWIDTH, MAJCNT 00204 INTEGER MAX , MAXSTK, MINCNT, MLINE , NCHPWD, NEWNO 00205 INTEGER NEXTNO, NUNITS, NXIFNO, OFFSET, OFFST2, P 00206 INTEGER PARAM1, PARAM2, PARAM3, PARAM4, PDUMMY, PENT 00207 INTEGER PARAM5 !25-JAN-80 00208 INTEGER PRIME , PTABLE, Q , QM , QP , READ 00209 INTEGER REFNO , RETNO , RETRY , S , SAFETY, SASSN1 00210 INTEGER SASSN2, SB , SB5I1 , SB6 , SB6I , SB7 , SBGOTO 00211 INTEGER SCONT 00212 INTEGER SCOMMA, SCP , SDASH , SDOST , SDUM , SEEDNO, SEQ 00213 INTEGER SETUP , SFLX , SFORCE, SGOTO , SGOTOI, SGUP1 00214 INTEGER SGOTOP 00215 INTEGER SGUP2 , SHOLD , SIF , SIFP , SIFPN , SLIST 00216 INTEGER SNE , SOURCE, SPB , SPGOTO, SPINV , SPUTGO 00217 INTEGER SRP , SRTN , SSPACR, SST , SSTMAX, SSTOP 00218 INTEGER SRPCI 00219 INTEGER STACK , STNO , SVER , TCEXP , TCOND , TDO 00220 INTEGER TELSE , TEND , TESTNO, TEXEC , TFIN , TFORT 00221 INTEGER TIF , TINVOK, TMAX , TOP , TOPNO , TOPTYP 00222 INTEGER TRUNTL, TRWHIL, TSELCT, TTO , TUNLES, TUNTIL 00223 INTEGER TWHEN , TWHILE, UDO , UEXP , UFORT , ULEN 00224 INTEGER UOWSE , UPINV , USTART, UTYPE , WWIDTH 00225 LOGICAL ALECS !20-FEB-80 00232 LOGICAL IMPSET !840307MAO 00233 LOGICAL COGOTO, FAKE , LONG 00234 LOGICAL DONE , ENDFIL, ENDPGM, ERLST , FIRST , FOUND , INSERT 00235 LOGICAL NOPGM , NOTFLG, PASS , SAVED ,SHORT , STREQ , STRLT 00236 DIMENSION UTYPE(3), USTART(3), ULEN(3) 00244 DIMENSION STACK(2000) 00247 DIMENSION ERRSTK(5) 00250 COMMON BLN , CLASS , DONE , ENDFIL, ENDPGM, ERLST 00259 COMMON ERROR , ERRSTK, ERSTOP, EXTYPE, FIRST , FLXNO 00260 COMMON FOUND , HOLDNO, LEVEL , LINENO, LSTLEV, MAJCNT 00261 COMMON MINCNT, MLINE , NOPGM , NUNITS, PASS , PTABLE, QP 00262 COMMON REFNO , SAVED , SFLX , SHOLD , SLIST , SOURCE 00263 COMMON SPINV , SPUTGO, SST , STACK , TOP , ULEN 00264 COMMON USTART, UTYPE , WWIDTH 00265 COMMON /PARAM/ PARAM1, PARAM2, PARAM3, PARAM4, PARAM5 !25-JAN-80 00358 DIMENSION SFLX (51) 00371 DIMENSION SHOLD (51) 00373 DIMENSION SLIST (101) 00375 DIMENSION SPINV (41) 00377 DIMENSION SPUTGO (11) 00379 DIMENSION SST (101) 00381 DIMENSION SASSN1 (8) 00387 DIMENSION SASSN2 (4) 00390 DIMENSION SB (2) 00393 DIMENSION SB5I1 (4) 00396 DIMENSION SB6 (4) 00399 DIMENSION SB7 (5) 00402 DIMENSION SB6I (5) 00405 DIMENSION SBGOTO (5) 00408 DIMENSION SCOMMA (2) 00411 DIMENSION SCONT (5) 00414 DIMENSION SCP (2) 00417 DIMENSION SDOST (6) 00420 DIMENSION SDASH (21) 00423 DIMENSION SDUM (9) 00428 DIMENSION SEQ (2) 00431 DIMENSION SFORCE (8) 00434 DIMENSION SGOTO (7) 00437 DIMENSION SGOTOI (8) 00440 DIMENSION SGOTOP (8) 00443 DIMENSION SGUP1 (30) 00446 DIMENSION SGUP2 (23) 00452 DIMENSION SIF (5) 00457 DIMENSION SIFP (6) 00460 DIMENSION SIFPN (8) 00463 DIMENSION SNE (3) 00466 DIMENSION SPB (2) 00469 DIMENSION SPGOTO (5) 00472 DIMENSION SRP (2) 00475 DIMENSION SRPCI (3) 00478 DIMENSION SRTN (7) 00481 DIMENSION SSPACR (3) 00484 DIMENSION SSTOP (9) 00487 DIMENSION SVER (12) 00490 DATA POUND/"43/ !# SIGN FOR COLUMN 1 !26-JUN-81MAO 00499 DATA FORTCL /1/, LISTCL /2/, ERRCL /3/ 00500 DATA ACSEQ/1/, AELSE/2/, AFSEQ/3/, AGCONT/4/, AGGOTO/5/ 00501 DATA AGSTNO/6/, AMSEQ/7/, AGRET/8/, ASSEQ/9/, ATSEQ/10/ 00502 DATA UEXP/1/, UFORT/2/, UOWSE/3/, UPINV/4/, UDO/5/ 00503 DATA UDIR/6/ !29-JUN-81MAO 00504 DATA TCEXP/1/, TELSE/2/, TEND/3/, TEXEC/4/, TFIN/5/, TTO/6/ 00505 DATA TDIR /7/ !22-JUN-81 00506 DATA TOFF /8/ !30JUN81MAO 00507 DATA TCOND/1/, TDO/2/, TFORT/3/, TIF/4/, TINVOK/5/, TRUNTL/6/ 00508 DATA TRWHIL/7/, TSELCT/8/, TUNLES/9/, TUNTIL/10/, TWHEN/11/ 00509 DATA TWHILE/12/ 00510 DATA DPAGE /1/ !22-JUN-81 00511 DATA DINCL /2/ !29-JUN-81MAO 00512 DATA DPIF /3/, DPUNL /4/, DPEND /5/ !30JUN81MAO 00513 DATA DNAME /6/ !30JUN81MAO 00514 DATA DIMP /7/ !840307MAO 00515 DATA SETUP /1/, RETRY /2/, READ /3/ 00516 DATA CHC /67/ 00517 DATA CINLIN /33/ !25-JAN-80 00518 DATA LWIDTH /132/ 00519 DATA MAXSTK /2000/ 00520 DATA NCHPWD /2/ 00521 DATA PRIME /53/ 00522 DATA SAFETY /35/ 00523 DATA SEEDNO /32760/ 00524 DATA LONG /.FALSE./ 00525 DATA SHORT /.TRUE./ 00526 DATA FAKE /.FALSE./ 00527 DATA COGOTO /.FALSE./ 00528 DATA CHSPAC /32/ 00529 DATA CHZERO /48/ 00530 DATA SSTMAX /200/ 00531 DATA SASSN1 / 13, 2H , 2H , 2H , 2HAS, 2HSI, 2HGN, 1H / 00532 DATA SASSN2 / 5, 2H T, 2HO , 1HI/ 00533 DATA SB / 1, 1H / 00534 DATA SB5I1 / 6, 2H , 2H , 2H 1/ 00535 DATA SB6 / 6, 2H , 2H , 2H / 00536 DATA SB7 / 7, 2H , 2H , 2H , 1H / 00537 DATA SB6I / 7, 2H , 2H , 2H , 1HI/ 00538 DATA SBGOTO / 7, 2H G, 2HO , 2HTO, 1H / 00539 DATA SCOMMA / 1, 1H,/ 00540 DATA SCONT / 8, 2HCO, 2HNT, 2HIN, 2HUE/ 00541 DATA SCP / 2, 2H,(/ 00542 DATA SDOST / 9, 2H , 2H , 2H , 2HDO, 1H / 00543 DATA SDASH / 40, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00544 1 , 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 00545 1 , 2H--, 2H--, 2H--, 2H--/ 00546 DATA SDUM / 15, 2HDU, 2HMM, 2HY-, 2HPR, 2HOC, 2HED, 2HUR, 1HE/ 00547 DATA SEQ / 1, 1H=/ 00548 DATA SFORCE / 14, 2H , 2H , 2H , 2HCO, 2HNT, 2HIN, 2HUE/ 00549 DATA SGOTO / 12, 2H , 2H , 2H , 2HGO, 2H T, 2HO / 00550 DATA SGOTOI / 13, 2H , 2H , 2H , 2HGO, 2H T, 2HO , 1HI/ 00551 DATA SGOTOP / 13, 2H , 2H , 2H , 2HGO, 2H T, 2HO , 1H(/ 00552 DATA SGUP1 / 57, 2H**, 2H**, 2H* , 2HTR, 2HAN, 2HSL, 2HAT, 2HOR 00553 1 , 2H H, 2HAS, 2H U, 2HSE, 2HD , 2HUP, 2H I, 2HTS 00554 1 , 2H A, 2HLL, 2HOT, 2HED, 2H S, 2HPA, 2HCE, 2H F 00555 1 , 2HOR, 2H T, 2HAB, 2HLE, 1HS/ 00556 DATA SGUP2 / 44, 2H**, 2H**, 2H* , 2HTR, 2HAN, 2HSL, 2HAT, 2HIO 00557 1 , 2HN , 2HMU, 2HST, 2H T, 2HER, 2HMI, 2HNA, 2HTE 00558 1 , 2H I, 2HMM, 2HED, 2HIA, 2HTE, 2HLY/ 00559 DATA SIF / 8, 2H , 2H , 2H , 2HIF/ 00560 DATA SIFP / 9, 2H , 2H , 2H , 2HIF, 1H(/ 00561 DATA SIFPN / 14, 2H , 2H , 2H , 2HIF, 2H(., 2HNO, 2HT./ 00562 DATA SNE / 4, 2H.N, 2HE./ 00563 DATA SPB / 2, 2H) / 00564 DATA SPGOTO / 8, 2H) , 2HGO, 2H T, 2HO / 00565 DATA SRP / 1, 1H)/ 00566 DATA SRPCI / 4, 2H),, 2H I/ 00567 DATA SRTN / 12, 2H , 2H , 2H , 2HRE, 2HTU, 2HRN/ 00568 DATA SSPACR / 3, 2H. , 1H / 00569 DATA SSTOP / 15, 2H , 2H , 2H , 2HCA, 2HLL, 2H E, 2HXI, 1HT/ 00570 DATA SVER / 21, 2H(F, 2HLE, 2HCS, 2H V, 2HER, 2HSI, 2HON, 2H 2 00571 1 , 2H2., 2H38, 1H)/ 00572 ASSIGN 32757 TO I32758 00578 GO TO 32758 00578 32757 GO TO 32755 00579 32756 IF(DONE) GO TO 32754 00579 32755 NOCALL=NOCALL+1 !ONE MORE CALL MADE TO OPENF 00580 CALL OPENF(NOCALL,DONE,SVER) !GET CMD LINE, OPEN FTN,FLL,FLX 00581 IF(DONE) GO TO 32753 00582 ENDFIL=.FALSE. 00583 MINCNT=0 !NUMBER OF WARNINGS 00584 MAJCNT=0 !NUMBER OF ERRORS 00585 LINENO=0 !INITIALIZE LINE # FOR FLX FILE 00586 GO TO 32751 00587 32752 IF(ENDFIL) GO TO 32750 00587 32751 ASSIGN 32748 TO I32749 00588 GO TO 32749 00588 32748 ASSIGN 32746 TO I32747 00589 GO TO 32747 00589 32746 GO TO 32752 00590 32750 CALL CLOSEF(MINCNT,MAJCNT) !CLOSE FLX,FTN,FLL FILES 00591 32753 GO TO 32756 00593 32754 CALL EXFLE !MAO, 30-APR-80 00594 32745 CONTINUE 00595 CALL CPYSUB (SST,SFLX,USTART(1),ULEN(1)) 00599 CALL NEWNAM (SST(1),SST(2)) 00600 GO TO I32745 00601 32744 CONTINUE 00602 ASSIGN 32742 TO I32743 00603 GO TO 32743 00603 32742 ASSIGN 32740 TO I32741 00604 GO TO 32741 00604 32740 IF(.NOT.(UTYPE(1).EQ.UEXP)) GO TO 32738 00605 GOTONO=NEWNO(0) 00606 STACK(TOP-2)=GOTONO 00607 ASSIGN 32736 TO I32737 00608 GO TO 32737 00608 32736 GO TO 32739 00609 32738 STACK(TOP-2)=0 !OTHERWISE CLAUSE 00610 32739 ASSIGN 32734 TO I32735 00611 GO TO 32735 00611 32734 GO TO I32744 00612 32733 CONTINUE 00613 TOP=TOP+4 00618 STACK(TOP)=ACSEQ 00619 STACK(TOP-1)=LINENO 00620 STACK(TOP-2)=0 00621 STACK(TOP-3)=0 00622 LEVEL=LEVEL+1 00623 ASSIGN 32732 TO I32741 00624 GO TO 32741 00624 32732 GO TO I32733 00625 32731 CONTINUE 00626 CONTNO=NEWNO(0) 00639 ASSIGN 32729 TO I32730 00640 GO TO 32730 00640 32729 CALL CPYSTR(SST,SDOST) 00641 CALL CATNUM(SST,CONTNO) 00642 CALL CATSTR(SST,SB) 00643 CALL CATSUB(SST,SFLX,USTART(1)+1,ULEN(1)-2) 00644 STNO=FLXNO 00645 FLXNO=0 00646 ASSIGN 32727 TO I32728 00647 GO TO 32728 00647 32727 CONTINUE 00648 ASSIGN 32726 TO I32735 00649 GO TO 32735 00649 32726 GO TO I32731 00650 32725 CONTINUE 00651 TOP=TOP-2 00652 ASSIGN 32724 TO I32741 00653 GO TO 32741 00653 32724 IF(.NOT.(NUNITS.EQ.1)) GO TO 32722 00654 IF(.NOT.(UTYPE(1).EQ.UPINV)) GO TO 32720 00655 ASSIGN 32718 TO I32719 00655 GO TO 32719 00655 32718 GO TO 32721 00655 32720 CALL CPYSUB(SST,SFLX,USTART(1),ULEN(1)) 00657 IF(STREQ(SST,SCONT)) GO TO 32717 00658 ASSIGN 32715 TO I32716 00658 GO TO 32716 00658 32715 CONTINUE 00658 32717 CONTINUE 00659 32721 GO TO 32723 00660 32722 ASSIGN 32713 TO I32714 00661 GO TO 32714 00661 32713 CONTINUE 00661 32723 GO TO I32725 00662 32712 CONTINUE 00663 IF(.NOT.(CNDLVL.NE.0)) GO TO 32710 00664 ERROR=404 !30JUN81MAO 00664 GO TO 32711 00664 32710 ASSIGN 32708 TO I32709 00666 GO TO 32709 00666 32708 ASSIGN 32706 TO I32707 00668 GO TO 32707 00668 32706 IF (ENDFIL) ERROR=25 00669 ENDPGM=.TRUE. 00670 IF(.NOT.(IMPSET)) GO TO 32705 00672 CALL IMPCLS !840307MAO 00673 IMPSET=.FALSE. !840307MAO 00674 32705 CONTINUE 00676 32711 GO TO I32712 00678 32704 CONTINUE 00679 IF((TFORT).NE.(EXTYPE)) GO TO 32702 00681 ASSIGN 32701 TO I32707 00681 GO TO 32707 00681 32701 GO TO 32703 00682 32702 IF((TIF).NE.(EXTYPE)) GO TO 32700 00682 ASSIGN 32698 TO I32699 00682 GO TO 32699 00682 32698 GO TO 32703 00683 32700 IF((TUNLES).NE.(EXTYPE)) GO TO 32697 00683 ASSIGN 32695 TO I32696 00683 GO TO 32696 00683 32695 GO TO 32703 00684 32697 IF((TWHEN).NE.(EXTYPE)) GO TO 32694 00684 ASSIGN 32692 TO I32693 00684 GO TO 32693 00684 32692 GO TO 32703 00685 32694 IF((TWHILE).NE.(EXTYPE)) GO TO 32691 00685 ASSIGN 32689 TO I32690 00685 GO TO 32690 00685 32689 GO TO 32703 00686 32691 IF((TUNTIL).NE.(EXTYPE)) GO TO 32688 00686 ASSIGN 32686 TO I32687 00686 GO TO 32687 00686 32686 GO TO 32703 00687 32688 IF((TRWHIL).NE.(EXTYPE)) GO TO 32685 00687 ASSIGN 32683 TO I32684 00687 GO TO 32684 00687 32683 GO TO 32703 00688 32685 IF((TRUNTL).NE.(EXTYPE)) GO TO 32682 00688 ASSIGN 32680 TO I32681 00688 GO TO 32681 00688 32680 GO TO 32703 00689 32682 IF((TINVOK).NE.(EXTYPE)) GO TO 32679 00689 ASSIGN 32678 TO I32719 00689 GO TO 32719 00689 32678 GO TO 32703 00690 32679 IF((TCOND).NE.(EXTYPE)) GO TO 32677 00690 ASSIGN 32676 TO I32733 00690 GO TO 32733 00690 32676 GO TO 32703 00691 32677 IF((TSELCT).NE.(EXTYPE)) GO TO 32675 00691 ASSIGN 32673 TO I32674 00691 GO TO 32674 00691 32673 GO TO 32703 00692 32675 IF((TDO).NE.(EXTYPE)) GO TO 32672 00692 ASSIGN 32671 TO I32731 00692 GO TO 32731 00692 32671 CONTINUE 00693 32672 CONTINUE 00693 32703 GO TO I32704 00694 32716 CONTINUE 00695 STNO=FLXNO !IF STMNT # ON FLX LINE, PUT IT ON THIS LINE 00696 CALL CPYSTR(SST,SB6) !PUT IN 6 BLANKS 00697 IF(.NOT.(UTYPE(1).EQ.UFORT)) GO TO 32669 00698 J=1 00698 GO TO 32670 00698 32669 J=2 00699 32670 CALL CATSUB(SST,SFLX,USTART(J),ULEN(J)) !ADD ON FORTRAN LINE 00700 ASSIGN 32668 TO I32728 00701 GO TO 32728 00701 32668 GO TO I32716 00702 32699 CONTINUE 00703 IF(.NOT.(NUNITS.EQ.2.AND.UTYPE(2).EQ.UFORT)) GO TO 32666 00708 ASSIGN 32665 TO I32707 00708 GO TO 32707 00708 32665 GO TO 32667 00708 32666 ASSIGN 32663 TO I32664 00709 GO TO 32664 00709 32663 CONTINUE 00709 32667 CONTINUE 00710 GO TO I32699 00711 32719 CONTINUE 00712 ASSIGN 32661 TO I32662 00713 GO TO 32662 00713 32661 ENTNO=STACK(PENT+1) !START OF PROCEDURE STMNT # 00714 RETNO=NEWNO(0) !WHERE TO RETURN FROM THIS CALL 00715 MAX=MAX-(1+OFFSET) 00716 STACK(MAX+1)=STACK(PENT+3) 00717 STACK(PENT+3)=MAX+1 00718 STACK(MAX+2)=LINENO 00719 IF (LONG.OR.COGOTO) STACK(MAX+3)=RETNO 00720 IF(.NOT.(COGOTO)) GO TO 32659 00726 STACK(PENT-2)=STACK(PENT-2)+1 00727 CALL CPYSTR(SST,SB6I) 00728 CALL CATNUM(SST,ENTNO) 00729 CALL CATSTR(SST,SEQ) 00730 CALL CATNUM(SST,STACK(PENT-2)) 00731 GO TO 32660 00732 32659 CALL CPYSTR(SST,SASSN1) 00734 CALL CATNUM(SST,RETNO) 00735 CALL CATSTR(SST,SASSN2) 00736 CALL CATNUM(SST,ENTNO) !ASSIGN 'RETNO' TO I'ENTNO 00737 32660 STNO=FLXNO 00739 ASSIGN 32658 TO I32728 00740 GO TO 32728 00740 32658 GOTONO=ENTNO 00741 ASSIGN 32656 TO I32657 00742 GO TO 32657 00742 32656 NEXTNO=RETNO !NEXT STMNT #=RETURN PLACE FROM PROCEDURE 00743 GO TO I32719 00745 32681 CONTINUE 00746 NOTFLG=.FALSE. 00747 ASSIGN 32655 TO I32684 00748 GO TO 32684 00748 32655 GO TO I32681 00749 32684 CONTINUE 00750 ASSIGN 32654 TO I32741 00751 GO TO 32741 00751 32654 TESTNO=NEWNO(0) !# ON IF(.NOT. 00752 TOPNO=NEWNO(0) !# AT TOP OF SCOPE 00753 ENDNO=NEWNO(0) !# PAST END OF LOOP 00754 GOTONO=TOPNO 00755 ASSIGN 32653 TO I32657 00756 GO TO 32657 00756 32653 STNO=TESTNO 00757 GOTONO=ENDNO 00758 ASSIGN 32652 TO I32737 00759 GO TO 32737 00759 32652 GSTNO=ENDNO 00760 ASSIGN 32650 TO I32651 00761 GO TO 32651 00761 32650 GGOTON=TESTNO 00762 ASSIGN 32648 TO I32649 00763 GO TO 32649 00763 32648 NEXTNO=TOPNO !NEXT STMNT #=TOPNO 00764 ASSIGN 32647 TO I32735 00765 GO TO 32735 00765 32647 GO TO I32684 00766 32674 CONTINUE 00767 ASSIGN 32646 TO I32741 00768 GO TO 32741 00768 32646 LEVEL=LEVEL+1 00769 L=(ULEN(1)-1)/NCHPWD+6 !PREPARE TO STORE EXPRESSION ON STACK 00770 TOP=TOP+L+1 00771 IF(.NOT.(TOP+SAFETY.LT.MAX)) GO TO 32644 00772 STACK(TOP)=ASSEQ 00773 STACK(TOP-1)=LINENO 00774 STACK(TOP-2)=0 00775 STACK(TOP-3)=0 00776 STACK(TOP-4)=L 00777 STACK(TOP-L)=0 00778 CALL CATSUB(STACK(TOP-L),SFLX,USTART(1),ULEN(1)) !PUT ON STACK 00779 GO TO 32645 00780 32644 ASSIGN 32642 TO I32643 00781 GO TO 32643 00781 32642 CONTINUE 00781 32645 GO TO I32674 00782 32641 CONTINUE 00783 LEVEL=LEVEL-1 00784 ASSIGN 32640 TO I32741 00785 GO TO 32741 00785 32640 STNO=STACK(TOP-2) 00786 IF(STNO.EQ.0) GO TO 32639 00787 ASSIGN 32637 TO I32638 00787 GO TO 32638 00787 32637 CONTINUE 00787 32639 ASSIGN 32635 TO I32636 00788 GO TO 32636 00788 32635 NEXTNO=STACK(TOP-3) !GET # BEYOND END OF CONDITIONAL 00789 ASSIGN 32633 TO I32634 00790 GO TO 32634 00790 32633 GO TO I32641 00791 32632 CONTINUE 00792 ASSIGN 32631 TO I32743 00793 GO TO 32743 00793 32631 ASSIGN 32630 TO I32741 00794 GO TO 32741 00794 32630 IF(.NOT.(UTYPE(1).EQ.UEXP)) GO TO 32628 00795 CALL CPYSTR(SST,SIFP) 00805 CALL CATSUB(SST,SFLX,USTART(1),ULEN(1)) 00806 CALL CATSTR(SST,SNE) 00807 I=STACK(TOP-4) 00808 CALL CATSTR(SST,STACK(TOP-I)) 00809 CALL CATSTR(SST,SPGOTO) 00810 NXIFNO=NEWNO(0) 00811 STACK(TOP-2)=NXIFNO 00812 CALL CATNUM(SST,NXIFNO) !"IF((E1.NE.(E))GOTO NXIFNO" 00813 STNO=0 00814 ASSIGN 32627 TO I32728 00815 GO TO 32728 00815 32627 CONTINUE 00816 GO TO 32629 00817 32628 STACK(TOP-2)=0 !FOR (OTHERWISE) 00818 32629 ASSIGN 32626 TO I32735 00819 GO TO 32735 00819 32626 GO TO I32632 00820 32625 CONTINUE 00821 ASSIGN 32624 TO I32741 00825 GO TO 32741 00825 32624 LEVEL=LEVEL-1 00826 TOP=TOP-2 00827 GO TO I32625 00828 32623 CONTINUE 00829 ASSIGN 32622 TO I32662 00830 GO TO 32662 00830 32622 IF(.NOT.(STACK(PENT+2).NE.0)) GO TO 32620 00831 ERROR=26 00832 MLINE=STACK(PENT+2) 00833 ENTNO=NEWNO(0) 00834 GO TO 32621 00835 32620 ENTNO=STACK(PENT+1) 00837 STACK(PENT+2)=LINENO 00838 32621 ASSIGN 32619 TO I32741 00840 GO TO 32741 00840 32619 ASSIGN 32618 TO I32636 00841 GO TO 32636 00841 32618 NEXTNO=ENTNO 00842 ASSIGN 32617 TO I32636 00843 GO TO 32636 00843 32617 TOP=TOP+2 00844 STACK(TOP)=AGRET 00845 IF(.NOT.(SHORT.OR.FAKE)) GO TO 32615 00846 STACK(TOP-1)=ENTNO !SHORT .T. AT LAMPF 00846 GO TO 32616 00846 32615 STACK(TOP-1)=STACK(PENT-1) 00847 32616 UTYPE(1)=0 00848 ASSIGN 32614 TO I32735 00849 GO TO 32735 00849 32614 GO TO I32623 00850 32696 CONTINUE 00851 IF(.NOT.(NUNITS.EQ.2.AND.UTYPE(2).EQ.UFORT)) GO TO 32612 00857 CALL CPYSTR(SST,SIFPN) 00858 CALL CATSUB(SST,SFLX,USTART(1),ULEN(1)) 00859 CALL CATSTR(SST,SPB) 00860 CALL CATSUB(SST,SFLX,USTART(2),ULEN(2)) 00861 STNO=FLXNO 00862 ASSIGN 32611 TO I32728 00863 GO TO 32728 00863 32611 GO TO 32613 00864 32612 NOTFLG=.FALSE. 00866 ASSIGN 32610 TO I32664 00867 GO TO 32664 00867 32610 CONTINUE 00868 32613 CONTINUE 00869 GO TO I32696 00870 32687 CONTINUE 00871 NOTFLG=.FALSE. 00872 ASSIGN 32609 TO I32690 00873 GO TO 32690 00873 32609 GO TO I32687 00874 32693 CONTINUE 00875 ENDNO=NEWNO(0) !PAST END OF WHEN-ELSE 00876 ELSNO=NEWNO(0) !START OF ELSE 00877 GSTNO=ENDNO 00878 ASSIGN 32608 TO I32651 00879 GO TO 32651 00879 32608 TOP=TOP+2 00880 STACK(TOP-1)=LINENO 00881 STACK(TOP)=AELSE !STACK CMD TO LOOK FOR ELSE 00882 GSTNO=ELSNO 00883 ASSIGN 32607 TO I32651 00884 GO TO 32651 00884 32607 GGOTON=ENDNO 00885 ASSIGN 32606 TO I32649 00886 GO TO 32649 00886 32606 GOTONO=ELSNO !WHERE TO GO IF LOGICAL CONDITION FALSE 00887 STNO=FLXNO 00888 FLXNO=0 00889 ASSIGN 32605 TO I32737 00890 GO TO 32737 00890 32605 ASSIGN 32604 TO I32735 00891 GO TO 32735 00891 32604 GO TO I32693 00892 32690 CONTINUE 00893 IF(.NOT.(FLXNO.NE.0)) GO TO 32602 00895 LOOPNO=FLXNO 00896 FLXNO=0 00897 GO TO 32603 00899 32602 IF(.NOT.(NEXTNO.NE.0)) GO TO 32601 00899 LOOPNO=NEXTNO 00900 NEXTNO=0 00901 GO TO 32603 00903 32601 LOOPNO=NEWNO(0) 00904 32603 ENDNO=NEWNO(0) 00907 GSTNO=ENDNO 00908 ASSIGN 32600 TO I32651 00909 GO TO 32651 00909 32600 GGOTON=LOOPNO 00910 ASSIGN 32599 TO I32649 00911 GO TO 32649 00911 32599 GOTONO=ENDNO 00912 STNO=LOOPNO 00913 ASSIGN 32598 TO I32737 00914 GO TO 32737 00914 32598 ASSIGN 32597 TO I32735 00915 GO TO 32735 00915 32597 GO TO I32690 00916 32735 CONTINUE 00917 IF(.NOT.(NUNITS.EQ.1)) GO TO 32595 00923 ASSIGN 32594 TO I32714 00923 GO TO 32714 00923 32594 GO TO 32596 00924 32595 IF(.NOT.(UTYPE(2).EQ.UPINV)) GO TO 32593 00924 ASSIGN 32592 TO I32719 00924 GO TO 32719 00924 32592 GO TO 32596 00925 32593 CALL CPYSUB(SST,SFLX,USTART(2),ULEN(2)) !IS IT JUST "CONTINUE"? 00926 IF(STREQ(SST,SCONT)) GO TO 32591 00927 ASSIGN 32590 TO I32716 00927 GO TO 32716 00927 32590 CONTINUE 00927 32591 CONTINUE 00929 32596 GO TO I32735 00930 32662 CONTINUE 00931 IF(.NOT.(UTYPE(1).EQ.UPINV)) GO TO 32588 00932 J=1 00932 GO TO 32589 00932 32588 J=2 00933 32589 CALL CPYSUB(SPINV,SFLX,USTART(J),ULEN(J)) 00934 IF(.NOT.(STREQ(SPINV,SDUM))) GO TO 32586 00935 PENT=PDUMMY 00936 STACK(PENT+2)=0 00937 GO TO 32587 00938 32586 P=MAXSTK-HASH(SPINV,PRIME) 00940 FOUND=.FALSE. 00941 IF(STACK(P).EQ.0) GO TO 32585 00942 GO TO 32583 00943 32584 IF(STACK(P).EQ.0.OR.FOUND) GO TO 32582 00943 32583 P=STACK(P) 00944 IF (STREQ(SPINV,STACK(P+4))) FOUND=.TRUE. 00945 GO TO 32584 00946 32582 CONTINUE 00947 32585 IF(.NOT.(FOUND)) GO TO 32580 00948 PENT=P 00948 GO TO 32581 00948 32580 TMAX=MAX-(4+OFFST2+(SPINV(1)+NCHPWD-1)/NCHPWD) 00950 IF(.NOT.(TMAX.LE.TOP+SAFETY)) GO TO 32578 00951 PENT=PDUMMY 00952 STACK(PENT+2)=0 00953 GO TO 32579 00954 32578 MAX=TMAX 00956 PENT=MAX+OFFST2 00957 IF (LONG.OR.COGOTO) STACK(PENT-1)=NEWNO(0) 00958 IF (COGOTO) STACK(PENT-2)=0 00959 STACK(PENT)=0 00960 STACK(P)=PENT 00961 STACK(PENT+1)=NEWNO(0) 00962 IF(IMPSET)CALL IMPWRT(STACK(PENT+1),LINENO,FORTCL)!840814MAO 00964 STACK(PENT+2)=0 00966 STACK(PENT+3)=0 00967 CALL CPYSTR(STACK(PENT+4),SPINV) 00968 32579 CONTINUE 00970 32581 CONTINUE 00971 32587 GO TO I32662 00972 32664 CONTINUE 00973 GOTONO=NEWNO(0) !GET STMNT # TO GOTO 00974 STNO=FLXNO 00975 FLXNO=0 00976 ASSIGN 32577 TO I32737 00977 GO TO 32737 00977 32577 GSTNO=GOTONO 00978 ASSIGN 32576 TO I32651 00979 GO TO 32651 00979 32576 ASSIGN 32575 TO I32735 00980 GO TO 32735 00980 32575 GO TO I32664 00981 32636 CONTINUE 00982 IF(.NOT.(NEXTNO.NE.0)) GO TO 32574 00987 CALL PUTNUM(SFORCE,NEXTNO) 00992 CALL PUT(LINENO,SFORCE,FORTCL) 00993 NEXTNO=0 00995 32574 GO TO I32636 00997 32573 CONTINUE 00998 ASSIGN 32572 TO I32636 01003 GO TO 32636 01003 32572 IF(.NOT.(STNO.NE.0)) GO TO 32571 01004 NEXTNO=STNO 01005 ASSIGN 32570 TO I32636 01006 GO TO 32636 01006 32570 STNO=0 01007 32571 IF(.NOT.(FLXNO.NE.0)) GO TO 32569 01009 NEXTNO=FLXNO 01010 ASSIGN 32568 TO I32636 01011 GO TO 32636 01011 32568 FLXNO=0 01012 32569 GO TO I32573 01014 32743 CONTINUE 01015 ENDNO=STACK(TOP-3) 01019 IF(.NOT.(ENDNO.EQ.0)) GO TO 32566 01020 STACK(TOP-3)=NEWNO(0) 01021 GO TO 32567 01022 32566 GOTONO=ENDNO 01024 ASSIGN 32565 TO I32657 01025 GO TO 32657 01025 32565 CONTINUE 01026 32567 IF(.NOT.(NEXTNO.EQ.0)) GO TO 32563 01028 NEXTNO=STACK(TOP-2) 01028 GO TO 32564 01029 32563 IF(.NOT.(STACK(TOP-2).EQ.0)) GO TO 32562 01029 GO TO 32564 01030 32562 ASSIGN 32561 TO I32636 01031 GO TO 32636 01031 32561 NEXTNO=STACK(TOP-2) 01032 32564 GO TO I32743 01035 32560 CONTINUE 01036 STNO=STACK(TOP-1) 01042 ASSIGN 32559 TO I32638 01043 GO TO 32638 01043 32559 CONTINUE 01044 TOP=TOP-2 01045 GO TO I32560 01046 32558 CONTINUE 01047 GOTONO=STACK(TOP-1) 01051 ASSIGN 32557 TO I32657 01052 GO TO 32657 01052 32557 TOP=TOP-2 01053 GO TO I32558 01054 32556 CONTINUE 01102 STNO=0 01103 CALL CPYSTR(SST,SGOTOI) 01109 IF (LONG.OR.COGOTO) SST(1)=SST(1)-1 01110 CALL CATNUM(SST,STACK(TOP-1)) !GOTO I# 01111 IF(.NOT.(FAKE)) GO TO 32555 01112 CALL CATSTR(SST,SCP) 01113 CALL CATNUM(SST,STACK(TOP-1)) 01114 CALL CATSTR(SST,SRP) 01115 32555 ASSIGN 32554 TO I32728 01117 GO TO 32728 01117 32554 CONTINUE 01118 TOP=TOP-2 01119 GO TO I32556 01120 32553 CONTINUE 01121 ASSIGN 32552 TO I32636 01126 GO TO 32636 01126 32552 NEXTNO=STACK(TOP-1) 01127 TOP=TOP-2 01128 GO TO I32553 01129 32643 CONTINUE 01130 CALL PUT(0,SGUP1,ERRCL) 01131 CALL PUT(0,SGUP2,ERRCL) 01132 CALL CLOSEF(MINCNT,-1) 01133 CALL EXFLE !MAO, 30-APR-80 01134 GO TO I32643 01135 32551 CONTINUE 01145 CALL CPYSUB (SST,SFLX,USTART(1),ULEN(1)) 01149 CALL OPNINC (SST(1),SST(2),ERROR) 01150 IF (ERROR.NE.0) ERROR=ERROR+300 01151 GO TO I32551 01152 32758 CONTINUE 01153 CALL LAMPFI(ALECS,CHC,CINLIN) !20-FEB-80 01157 NOCALL=0 !# OF TIMES OPENF HAS BEEN CALLED 01159 PARAM1=NCHPWD !# OF CHARACTERS PER INTEGER WORD 01160 PARAM2=CHZERO 01161 PARAM3=CHSPAC 01162 PARAM4=CHC !COMMENT CHARACTER 01163 PARAM5=CINLIN !IN-LINE COMMENT CHAR !25-JAN-80 01164 BLN=0 01165 WWIDTH=LWIDTH-18 !11-SEP-75, 830307 ADD FORT LINE # 01166 REFNO=(WWIDTH-6)/7 !11-SEP-75 !830311 01167 IF(.NOT.(SHORT.OR.FAKE)) GO TO 32549 01169 OFFSET=1 01170 OFFST2=1 01171 GO TO 32550 01173 32549 IF(.NOT.(COGOTO)) GO TO 32548 01173 OFFSET=2 01174 OFFST2=3 01175 GO TO 32550 01177 32548 OFFSET=2 01178 OFFST2=3 01179 32550 NOTFLG=.TRUE. 01182 ERLST=.FALSE. 01183 IMPSET=.FALSE. !840307MAO 01185 GO TO I32758 01186 32634 CONTINUE 01187 TOPTYP=STACK(TOP) 01188 IF((ASSEQ).NE.(TOPTYP)) GO TO 32546 01190 TOP=TOP-STACK(TOP-4)-1 01190 GO TO 32547 01191 32546 IF((ACSEQ).NE.(TOPTYP)) GO TO 32545 01191 TOP=TOP-4 01191 GO TO 32547 01192 32545 IF((AGGOTO).NE.(TOPTYP)) GO TO 32544 01192 TOP=TOP-2 01192 GO TO 32547 01193 32544 IF((AGCONT).NE.(TOPTYP)) GO TO 32543 01193 TOP=TOP-2 01193 GO TO 32547 01194 32543 IF((AFSEQ).NE.(TOPTYP)) GO TO 32542 01194 TOP=TOP-2 01194 GO TO 32547 01195 32542 IF((AELSE).NE.(TOPTYP)) GO TO 32541 01195 TOP=TOP-2 01195 GO TO 32547 01196 32541 IF((AGSTNO).NE.(TOPTYP)) GO TO 32540 01196 TOP=TOP-2 01196 GO TO 32547 01197 32540 IF((ATSEQ).NE.(TOPTYP)) GO TO 32539 01197 TOP=TOP-1 01197 GO TO 32547 01198 32539 IF((AMSEQ).NE.(TOPTYP)) GO TO 32538 01198 TOP=TOP-1 01198 GO TO 32547 01199 32538 IF((AGRET).NE.(TOPTYP)) GO TO 32537 01199 TOP=TOP-2 01199 32537 CONTINUE 01200 32547 GO TO I32634 01201 32749 CONTINUE 01202 DUMMY=NEWNO(SEEDNO) !INITIALIZE STMNT # GENERATOR 01205 ENDPGM=.FALSE. 01206 MAX=MAXSTK-(PRIME+OFFSET+3) 01207 PDUMMY=MAX+OFFSET 01208 DO 32536 I=MAX,MAXSTK 01209 STACK(I)=0 01209 32536 CONTINUE 01209 TOP=1 !START OF STACK 01210 STACK(TOP)=AMSEQ !INITIAL CMD: LOOK FOR FLECS MAIN LINE OR FORT 01211 ERROR=0 01212 FIRST=.TRUE. !THIS IS FIRST READ ON THIS FILE 01213 NOPGM=.FALSE. 01214 NEXTNO=0 !STMNT # FOR NEXT STMNT PUT IN FTN FILE 01215 SOURCE=READ !GET INPUT FROM FILE 01216 LEVEL=0 01217 LSTLEV=0 01218 PASFLG=.TRUE. !30JUN81MAO 01219 CNDLVL=0 !30JUN81MAO 01220 OFFLVL=0 !30JUN81MAO 01221 NUMLIN=0 !NO FORT LINES YET !830307 01223 GO TO I32749 01229 32535 CONTINUE 01230 IF((DPAGE).NE.(DTYPE)) GO TO 32533 01235 ASSIGN 32531 TO I32532 01235 GO TO 32532 01235 32531 GO TO 32534 01236 32533 IF((DINCL).NE.(DTYPE)) GO TO 32530 01236 ASSIGN 32529 TO I32551 01236 GO TO 32551 01236 32529 GO TO 32534 01237 32530 IF((DPIF).NE.(DTYPE)) GO TO 32528 01237 ASSIGN 32526 TO I32527 01237 GO TO 32527 01237 32526 GO TO 32534 01238 32528 IF((DPUNL).NE.(DTYPE)) GO TO 32525 01238 ASSIGN 32523 TO I32524 01238 GO TO 32524 01238 32523 GO TO 32534 01239 32525 IF((DPEND).NE.(DTYPE)) GO TO 32522 01239 ASSIGN 32520 TO I32521 01239 GO TO 32521 01239 32520 GO TO 32534 01240 32522 IF((DNAME).NE.(DTYPE)) GO TO 32519 01240 ASSIGN 32518 TO I32745 01240 GO TO 32745 01240 32518 CONTINUE 01241 GO TO 32534 01242 32519 IF((DIMP).NE.(DTYPE)) GO TO 32517 01242 ASSIGN 32515 TO I32516 01242 GO TO 32516 01242 32515 CONTINUE 01243 32517 CONTINUE 01244 32534 GO TO I32535 01245 32516 CONTINUE 01247 CALL IMPOPN (IMPSET,LINENO,FORTCL,ERRCL,MAJCNT) !840307MAO 01251 GO TO I32516 01252 32521 CONTINUE 01254 ASSIGN 32514 TO I32573 01255 GO TO 32573 01255 32514 IF(.NOT.(CNDLVL.EQ.0)) GO TO 32512 01256 ERROR=401 !extra .PASSEND 01256 GO TO 32513 01256 32512 IF (CNDLVL.EQ.OFFLVL) PASFLG=.TRUE. !back on 01258 CNDLVL=CNDLVL-1 01259 32513 GO TO I32521 01261 32527 CONTINUE 01262 ASSIGN 32511 TO I32573 01264 GO TO 32573 01264 32511 CNDLVL=CNDLVL+1 !one more level of conditional 01265 IF(.NOT.(PASFLG)) GO TO 32510 01266 CALL CPYSUB (SST,SFLX,USTART(1),ULEN(1)) !get the name 01270 IF(.NOT.(SST(1).GT.6)) GO TO 32509 01271 SST(1)=6 01272 ERROR=402 01273 32509 IF (SST(1).LT.1) ERROR=403 !no name given! 01275 IF(.NOT.(ERROR.EQ.0)) GO TO 32508 01276 I=1 01277 FOUND=.FALSE. 01278 32507 IF(I.GT.COND .OR. FOUND) GO TO 32506 01279 FOUND=STREQ (SST,CNDVAL(1,I)) 01280 I=I+1 01281 GO TO 32507 01282 32506 IF(.NOT.(NOTFLG)) FOUND=.NOT.FOUND !invert for .PASSUNLESS 01284 IF(FOUND) GO TO 32505 01286 PASFLG=.FALSE. 01287 OFFLVL=CNDLVL 01288 32505 CONTINUE 01290 32508 CONTINUE 01291 32510 GO TO I32527 01292 32524 CONTINUE 01293 NOTFLG=.FALSE. !signal really PASSUNLESS 01294 ASSIGN 32504 TO I32527 01295 GO TO 32527 01295 32504 NOTFLG=.TRUE. !reset to default value 01296 GO TO I32524 01297 32747 CONTINUE 01298 GO TO 32502 01299 32503 IF(ENDPGM) GO TO 32501 01299 32502 IF(.NOT.(TOP+SAFETY.GT.MAX)) GO TO 32500 01300 ASSIGN 32499 TO I32643 01300 GO TO 32643 01300 32499 CONTINUE 01300 32500 ACTION=STACK(TOP) !ON FIRST PASS=AMSEQ 01301 IF((AGGOTO).NE.(ACTION)) GO TO 32497 01303 ASSIGN 32496 TO I32558 01303 GO TO 32558 01303 32496 GO TO 32498 01304 32497 IF((AGRET).NE.(ACTION)) GO TO 32495 01304 ASSIGN 32494 TO I32556 01304 GO TO 32556 01304 32494 GO TO 32498 01305 32495 IF((AGCONT).NE.(ACTION)) GO TO 32493 01305 ASSIGN 32492 TO I32560 01305 GO TO 32560 01305 32492 GO TO 32498 01306 32493 IF((AGSTNO).NE.(ACTION)) GO TO 32491 01306 ASSIGN 32490 TO I32553 01306 GO TO 32553 01306 32490 GO TO 32498 01307 32491 CALL ANALYZ !GET INPUT AND FIGURE OUT WHAT NEEDS DOING 01308 IF((AFSEQ).NE.(ACTION)) GO TO 32488 01310 IF((TDIR).NE.(CLASS)) GO TO 32486 01312 ASSIGN 32485 TO I32535 01312 GO TO 32535 01312 32485 GO TO 32487 01313 32486 IF((TEXEC).NE.(CLASS)) GO TO 32484 01313 ASSIGN 32483 TO I32704 01313 GO TO 32704 01313 32483 GO TO 32487 01314 32484 IF((TFIN).NE.(CLASS)) GO TO 32482 01314 ASSIGN 32481 TO I32625 01314 GO TO 32625 01314 32481 GO TO 32487 01315 32482 IF((TEND).NE.(CLASS)) GO TO 32480 01315 ERROR=1 01315 GO TO 32487 01316 32480 IF((TELSE).NE.(CLASS)) GO TO 32479 01316 ERROR=10 01316 GO TO 32487 01317 32479 IF((TTO).NE.(CLASS)) GO TO 32478 01317 ERROR=13 01317 GO TO 32487 01318 32478 IF((TCEXP).NE.(CLASS)) GO TO 32477 01318 ERROR=19 01318 GO TO 32487 01319 32477 IF((TOFF).NE.(CLASS)) GO TO 32476 01319 CONTINUE !30JUN81MAO 01319 32476 CONTINUE 01320 32487 GO TO 32489 01322 32488 IF((AMSEQ).NE.(ACTION)) GO TO 32475 01322 IF((TDIR).NE.(CLASS)) GO TO 32473 01324 ASSIGN 32472 TO I32535 01324 GO TO 32535 01324 32472 GO TO 32474 01325 32473 IF((TEXEC).NE.(CLASS)) GO TO 32471 01325 ASSIGN 32470 TO I32704 01325 GO TO 32704 01325 32470 GO TO 32474 01326 32471 IF((TEND).NE.(CLASS)) GO TO 32469 01326 IF(.NOT.(NOPGM)) GO TO 32467 01327 ENDPGM=.TRUE. 01327 GO TO 32468 01327 32467 ASSIGN 32466 TO I32712 01328 GO TO 32712 01328 32466 CONTINUE 01328 32468 GO TO 32474 01330 32469 IF((TFIN).NE.(CLASS)) GO TO 32465 01330 ERROR=5 01330 GO TO 32474 01331 32465 IF((TELSE).NE.(CLASS)) GO TO 32464 01331 ERROR=8 01331 GO TO 32474 01332 32464 IF((TTO).NE.(CLASS)) GO TO 32463 01332 STACK(TOP)=ATSEQ !NOTE TOP NOT SHIFTED!!-->ONLY PROC DFN LEGAL 01333 ASSIGN 32462 TO I32623 01334 GO TO 32623 01334 32462 GO TO 32474 01336 32463 IF((TCEXP).NE.(CLASS)) GO TO 32461 01336 ERROR=17 01336 GO TO 32474 01337 32461 IF((TOFF).NE.(CLASS)) GO TO 32460 01337 CONTINUE !30JUN81MAO 01337 32460 CONTINUE 01338 32474 GO TO 32489 01340 32475 IF((ASSEQ).NE.(ACTION)) GO TO 32459 01340 IF((TDIR).NE.(CLASS)) GO TO 32457 01342 ASSIGN 32456 TO I32535 01342 GO TO 32535 01342 32456 GO TO 32458 01343 32457 IF((TCEXP).NE.(CLASS)) GO TO 32455 01343 ASSIGN 32454 TO I32632 01343 GO TO 32632 01343 32454 GO TO 32458 01344 32455 IF((TFIN).NE.(CLASS)) GO TO 32453 01344 ASSIGN 32452 TO I32641 01344 GO TO 32641 01344 32452 GO TO 32458 01345 32453 IF((TEND).NE.(CLASS)) GO TO 32451 01345 ERROR=3 01345 GO TO 32458 01346 32451 IF((TELSE).NE.(CLASS)) GO TO 32450 01346 ERROR=12 01346 GO TO 32458 01347 32450 IF((TTO).NE.(CLASS)) GO TO 32449 01347 ERROR=15 01347 GO TO 32458 01348 32449 IF((TEXEC).NE.(CLASS)) GO TO 32448 01348 ERROR=23 01348 GO TO 32458 01349 32448 IF((TOFF).NE.(CLASS)) GO TO 32447 01349 CONTINUE !30JUN81MAO 01349 32447 CONTINUE 01350 32458 GO TO 32489 01352 32459 IF((ACSEQ).NE.(ACTION)) GO TO 32446 01352 IF((TDIR).NE.(CLASS)) GO TO 32444 01354 ASSIGN 32443 TO I32535 01354 GO TO 32535 01354 32443 GO TO 32445 01355 32444 IF((TCEXP).NE.(CLASS)) GO TO 32442 01355 ASSIGN 32441 TO I32744 01355 GO TO 32744 01355 32441 GO TO 32445 01356 32442 IF((TFIN).NE.(CLASS)) GO TO 32440 01356 ASSIGN 32439 TO I32641 01356 GO TO 32641 01356 32439 GO TO 32445 01357 32440 IF((TEND).NE.(CLASS)) GO TO 32438 01357 ERROR=2 01357 GO TO 32445 01358 32438 IF((TELSE).NE.(CLASS)) GO TO 32437 01358 ERROR=11 01358 GO TO 32445 01359 32437 IF((TTO).NE.(CLASS)) GO TO 32436 01359 ERROR=14 01359 GO TO 32445 01360 32436 IF((TEXEC).NE.(CLASS)) GO TO 32435 01360 ERROR=22 01360 GO TO 32445 01361 32435 IF((TOFF).NE.(CLASS)) GO TO 32434 01361 CONTINUE !30JUN81MAO 01361 32434 CONTINUE 01362 32445 GO TO 32489 01364 32446 IF((AELSE).NE.(ACTION)) GO TO 32433 01364 IF((TDIR).NE.(CLASS)) GO TO 32431 01366 ASSIGN 32430 TO I32535 01366 GO TO 32535 01366 32430 GO TO 32432 01367 32431 IF((TELSE).NE.(CLASS)) GO TO 32429 01367 ASSIGN 32428 TO I32725 01367 GO TO 32725 01367 32428 GO TO 32432 01368 32429 IF((TEND).NE.(CLASS)) GO TO 32427 01368 ERROR=4 01368 GO TO 32432 01369 32427 IF((TFIN).NE.(CLASS)) GO TO 32426 01369 ERROR=7 01369 GO TO 32432 01370 32426 IF((TTO).NE.(CLASS)) GO TO 32425 01370 ERROR=16 01370 GO TO 32432 01371 32425 IF((TCEXP).NE.(CLASS)) GO TO 32424 01371 ERROR=20 01371 GO TO 32432 01372 32424 IF((TEXEC).NE.(CLASS)) GO TO 32423 01372 ERROR=24 01372 GO TO 32432 01373 32423 IF((TOFF).NE.(CLASS)) GO TO 32422 01373 CONTINUE !30JUN81MAO 01373 32422 CONTINUE 01374 32432 GO TO 32489 01376 32433 IF((ATSEQ).NE.(ACTION)) GO TO 32421 01376 IF((TDIR).NE.(CLASS)) GO TO 32419 01378 ASSIGN 32418 TO I32535 01378 GO TO 32535 01378 32418 GO TO 32420 01379 32419 IF((TTO).NE.(CLASS)) GO TO 32417 01379 ASSIGN 32416 TO I32623 01379 GO TO 32623 01379 32416 GO TO 32420 01380 32417 IF((TEND).NE.(CLASS)) GO TO 32415 01380 ASSIGN 32414 TO I32712 01380 GO TO 32712 01380 32414 GO TO 32420 01381 32415 IF((TFIN).NE.(CLASS)) GO TO 32413 01381 ERROR=6 01381 GO TO 32420 01382 32413 IF((TELSE).NE.(CLASS)) GO TO 32412 01382 ERROR=9 01382 GO TO 32420 01383 32412 IF((TCEXP).NE.(CLASS)) GO TO 32411 01383 ERROR=18 01383 GO TO 32420 01384 32411 IF((TEXEC).NE.(CLASS)) GO TO 32410 01384 ERROR=21 01384 GO TO 32420 01385 32410 IF((TOFF).NE.(CLASS)) GO TO 32409 01385 CONTINUE !30JUN81MAO 01385 32409 CONTINUE 01386 32420 CONTINUE 01388 32421 CONTINUE 01388 32489 IF(.NOT.(NOPGM .OR. CLASS.EQ.TOFF)) CALL LIST !30JUN81MAO 01389 32498 GO TO 32503 01392 32501 GO TO I32747 01393 32714 CONTINUE 01394 TOP=TOP+2 01395 STACK(TOP-1)=LINENO 01396 STACK(TOP)=AFSEQ 01397 LEVEL=LEVEL+1 01398 GO TO I32714 01399 32730 CONTINUE 01400 TOP=TOP+2 01401 STACK(TOP-1)=CONTNO 01402 STACK(TOP)=AGCONT 01403 GO TO I32730 01404 32649 CONTINUE 01405 TOP=TOP+2 01406 STACK(TOP-1)=GGOTON 01407 STACK(TOP)=AGGOTO 01408 GO TO I32649 01409 32651 CONTINUE 01410 TOP=TOP+2 01411 STACK(TOP-1)=GSTNO 01412 STACK(TOP)=AGSTNO 01413 GO TO I32651 01414 32638 CONTINUE 01415 ASSIGN 32408 TO I32636 01416 GO TO 32636 01416 32408 CONTINUE 01417 CALL PUTNUM(SFORCE,STNO) 01421 CALL PUT(LINENO,SFORCE,FORTCL) 01422 STNO=0 01424 GO TO I32638 01425 32707 CONTINUE 01426 CALL CPYSTR (SST,SFLX) !26JUN81MAO 01430 CALL GETCH (SST(2),1,I) !# IN COL 1? !26-JUN-81(MAO) 01431 IF (I.EQ.POUND)CALL PUTCH(SST(2),1,CHSPAC) !BLANK OUT !26JUN81MAO 01432 IF(.NOT.(NEXTNO.EQ.0)) GO TO 32406 01434 CALL PUT(LINENO,SST,FORTCL) !26JUN81MAO 01434 GO TO 32407 01435 32406 IF(.NOT.(FLXNO.NE.0.OR.PASS)) GO TO 32405 01435 ASSIGN 32404 TO I32636 01436 GO TO 32636 01436 32404 CALL PUT(LINENO,SST,FORTCL) !26JUN81MAO 01437 GO TO 32407 01439 32405 CONTINUE 01441 CALL PUTNUM(SST,NEXTNO) 01446 CALL PUT(LINENO,SST,FORTCL) 01447 NEXTNO=0 01449 32407 GO TO I32707 01452 32657 CONTINUE 01453 CALL CPYSTR(SPUTGO,SGOTO) 01459 CALL CATNUM(SPUTGO,GOTONO) 01460 IF(.NOT.(NEXTNO.NE.0)) GO TO 32403 01461 CALL PUTNUM(SPUTGO,NEXTNO) 01462 NEXTNO=0 01463 32403 CALL PUT(LINENO,SPUTGO,FORTCL) 01465 GO TO I32657 01467 32737 CONTINUE 01468 IF(.NOT.(NOTFLG)) GO TO 32401 01478 CALL CPYSTR(SST,SIFPN) 01478 GO TO 32402 01478 32401 CALL CPYSTR(SST,SIF) 01479 32402 CALL CATSUB(SST,SFLX,USTART(1),ULEN(1)) 01480 IF(.NOT.(NOTFLG)) GO TO 32399 01481 CALL CATSTR(SST,SPGOTO) 01481 GO TO 32400 01481 32399 CALL CATSTR(SST,SBGOTO) 01482 32400 CALL CATNUM(SST,GOTONO) 01483 ASSIGN 32398 TO I32728 01484 GO TO 32728 01484 32398 CONTINUE 01485 NOTFLG=.TRUE. 01486 GO TO I32737 01487 32532 CONTINUE 01488 CALL NEWPG 01492 GO TO I32532 01493 32728 CONTINUE 01494 IF(NEXTNO.EQ.0) GO TO 32397 01495 IF(.NOT.(STNO.EQ.0)) GO TO 32395 01496 STNO=NEXTNO 01497 NEXTNO=0 01498 GO TO 32396 01499 32395 ASSIGN 32394 TO I32636 01500 GO TO 32636 01500 32394 CONTINUE 01500 32396 CONTINUE 01501 32397 IF(STNO.EQ.0) GO TO 32393 01502 CALL PUTNUM(SST,STNO) 01507 STNO=0 01509 32393 IF(.NOT.(SST(1).LE.72)) GO TO 32391 01514 CALL PUT(LINENO,SST,FORTCL) 01514 GO TO 32392 01514 32391 ERROR=500 !Warning message from L!830308 01525 CALL CPYSUB (SLIST,SST,1,72) 01526 CALL PUT(LINENO,SLIST,FORTCL) 01527 S=73 01528 L=66 01529 GO TO 32389 01530 32390 IF(S.GT.SST(1)) GO TO 32388 01530 32389 IF(S+L-1.GT.SST(1)) L=SST(1)-S+1 01531 CALL CPYSTR(SLIST,SB5I1) 01532 CALL CATSUB(SLIST,SST,S,L) 01533 CALL PUT(LINENO,SLIST,FORTCL) 01534 IF(.NOT.(CNTALL)) NUMLIN=NUMLIN-1 !USUALLY DONT COUNT !830307 01535 S=S+66 01536 GO TO 32390 01537 32388 CONTINUE 01538 32392 GO TO I32728 01539 32387 CONTINUE 01540 LL=0 01541 LR=STACK(LP) 01542 32386 IF(LR.EQ.0) GO TO 32385 01543 LT=STACK(LR) 01544 STACK(LR)=LL 01545 LL=LR 01546 LR=LT 01547 GO TO 32386 01548 32385 STACK(LP)=LL 01549 GO TO I32387 01550 32741 CONTINUE 01551 IF(.NOT.(FLXNO.NE.0)) GO TO 32384 01552 ASSIGN 32383 TO I32636 01553 GO TO 32636 01553 32383 NEXTNO=FLXNO 01554 FLXNO=0 01555 32384 GO TO I32741 01557 32709 CONTINUE 01558 P=MAX 01559 STACK(MAX)=0 01560 ITEMP=MAXSTK-PRIME+1 01561 DO 32382 I=ITEMP,MAXSTK 01562 IF(STACK(I).EQ.0) GO TO 32381 01563 STACK(P)=STACK(I) 01564 GO TO 32379 01565 32380 IF(STACK(P).EQ.0) GO TO 32378 01565 32379 P=STACK(P) 01566 LP=P+3 01567 ASSIGN 32377 TO I32387 01568 GO TO 32387 01568 32377 GO TO 32380 01569 32378 CONTINUE 01570 32381 CONTINUE 01571 32382 CONTINUE 01571 Q=MAX-1 01572 STACK(Q)=0 01573 32376 IF(STACK(MAX).EQ.0) GO TO 32375 01574 P=STACK(MAX) 01575 STACK(MAX)=STACK(P) 01576 QM=Q 01577 QP=STACK(QM) 01578 INSERT=.FALSE. 01579 32374 IF(INSERT) GO TO 32373 01580 IF(.NOT.(QP.EQ.0)) GO TO 32371 01582 INSERT=.TRUE. 01582 GO TO 32372 01583 32371 IF(.NOT.(STRLT(STACK(P+4),STACK(QP+4)))) GO TO 32370 01583 INSERT=.TRUE. 01583 GO TO 32372 01584 32370 QM=QP 01585 QP=STACK(QM) 01586 32372 GO TO 32374 01589 32373 STACK(P)=QP 01590 STACK(QM)=P 01591 GO TO 32376 01592 32375 PTABLE=STACK(Q) 01593 GO TO I32709 01594 END 01595