SUBROUTINE ANALYZ INTEGER BLN , CH , CHC , CHSPAC, CHTYP , CHTYPE INTEGER CHZERO, CLASS , CPOS , CSAVE , CURSOR, CWD INTEGER ERRCL , ERROR , ERRSTK, ERSTOP INTEGER EXTYPE, FLXNO , FORTCL, HOLDNO, I , KCOND INTEGER KDO , KELSE , KEND , KFIN , KIF , KREPT INTEGER KSELCT, KTO , KUNLES, KUNTIL, KWHEN , KWHILE INTEGER LEN , LEVEL , LINENO, LISTCL, LSTLEV, MAJCNT INTEGER MINCNT, MLINE , NCHPWD, NUNITS, PCNT , PTABLE, QP INTEGER READ , REFNO ,RETRY , SB , SB5 , SB6 INTEGER SB7 , SDASH , SDUM , SEND , SETUP , SFLX INTEGER SFSPCR, SHOLD , SLIST , SLP , SOURCE, SOWSE INTEGER SP , SPINV , SPUTGO, SRP , SSPACR, SST INTEGER SSTMAX, STACK , START , TBLANK, TCEXP , TCOND INTEGER TDIGIT, TDO , TELSE , TEND , TEOL , TEXEC INTEGER TFIN , TFORT , THYPHN, TIF , TINVOK, TLETTR INTEGER TLP , TOP , TOTHER, TRP , TRUNTL, TRWHIL INTEGER TSELCT, TTO , TUNLES, TUNTIL, TWHEN , TWHILE INTEGER UDO , UEXP , UFORT , ULEN , UOWSE , UPINV INTEGER USTART, UTYPE , WWIDTH LOGICAL BADCH , CONT , DONE ,ENDFIL, ENDPGM, ERLST , FIRST LOGICAL FOUND , INDENT, INVOKE, NOPGM , PASS , SAVED , STREQ DIMENSION UTYPE(3), USTART(3), ULEN(3) DIMENSION STACK(2000) DIMENSION ERRSTK(5) 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 /PARAM/ NCHPWD, CHZERO, CHSPAC, CHC DIMENSION SFLX (51) DIMENSION SHOLD (51) DIMENSION SLIST (101) DIMENSION SPINV (41) DIMENSION SPUTGO (11) DIMENSION SST (101) DIMENSION SB (2) DIMENSION SB5 (4) DIMENSION SB6 (4) DIMENSION SB7 (5) DIMENSION SDASH (21) DIMENSION SDUM (9) DIMENSION SEND (6) DIMENSION SFSPCR (3) DIMENSION SLP (2) DIMENSION SOWSE (7) DIMENSION SRP (2) DIMENSION SSPACR (3) DIMENSION KCOND (7) DIMENSION KDO (2) DIMENSION KELSE (3) DIMENSION KEND (3) DIMENSION KFIN (3) DIMENSION KIF (2) DIMENSION KREPT (4) DIMENSION KSELCT (4) DIMENSION KTO (2) DIMENSION KUNLES (4) DIMENSION KUNTIL (4) DIMENSION KWHEN (3) DIMENSION KWHILE (4) DATA FORTCL /1/, LISTCL /2/, ERRCL /3/ DATA UEXP/1/, UFORT/2/, UOWSE/3/, UPINV/4/, UDO/5/ DATA TLETTR/1/, TDIGIT/2/, THYPHN/3/, TLP/4/, TRP/5/ DATA TBLANK/6/, TOTHER/7/, TEOL/8/ 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 SSTMAX /200/ DATA SB / 1, 1H / DATA SB5 / 5, 2H , 2H , 1H / DATA SB6 / 6, 2H , 2H , 2H / DATA SB7 / 7, 2H , 2H , 2H , 1H / DATA SDASH / 40, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 1 , 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H--, 2H-- 1 , 2H--, 2H--, 2H--, 2H--/ DATA SDUM / 15, 2HDU, 2HMM, 2HY-, 2HPR, 2HOC, 2HED, 2HUR, 1HE/ DATA SEND / 9, 2H , 2H , 2H , 2HEN, 1HD/ DATA SFSPCR / 3, 2H.., 1H./ DATA SLP / 1, 1H(/ DATA SOWSE / 11, 2H(O, 2HTH, 2HER, 2HWI, 2HSE, 1H)/ DATA SRP / 1, 1H)/ DATA SSPACR / 3, 2H. , 1H / DATA KCOND / 11, 2HCO, 2HND, 2HIT, 2HIO, 2HNA, 1HL/ DATA KDO / 2, 2HDO/ DATA KELSE / 4, 2HEL, 2HSE/ DATA KEND / 3, 2HEN, 1HD/ DATA KFIN / 3, 2HFI, 1HN/ DATA KIF / 2, 2HIF/ DATA KREPT / 6, 2HRE, 2HPE, 2HAT/ DATA KSELCT / 6, 2HSE, 2HLE, 2HCT/ DATA KTO / 2, 2HTO/ DATA KUNLES / 6, 2HUN, 2HLE, 2HSS/ DATA KUNTIL / 5, 2HUN, 2HTI, 1HL/ DATA KWHEN / 4, 2HWH, 2HEN/ DATA KWHILE / 5, 2HWH, 2HIL, 1HE/ IF((READ).NE.(SOURCE)) GO TO 32758 ASSIGN 32756 TO I32757 GO TO 32757 32756 GO TO 32759 32758 IF((SETUP).NE.(SOURCE)) GO TO 32755 GO TO 32759 32755 IF((RETRY).NE.(SOURCE)) GO TO 32754 LINENO=HOLDNO CALL CPYSTR(SFLX,SHOLD) 32754 CONTINUE 32759 ERROR=0 SAVED=.FALSE. NUNITS=0 ERSTOP=0 CURSOR=0 CWD=2 CPOS=0 CLASS=0 ASSIGN 32752 TO I32753 GO TO 32753 32752 ASSIGN 32750 TO I32751 GO TO 32751 32750 IF(.NOT.(CONT.OR.PASS)) GO TO 32748 CLASS=TEXEC EXTYPE=TFORT GO TO 32749 32748 ASSIGN 32746 TO I32747 GO TO 32747 32746 CONTINUE 32749 IF((TEXEC).NE.(CLASS)) GO TO 32744 IF((TFORT).NE.(EXTYPE)) GO TO 32742 GO TO 32743 32742 IF((TINVOK).NE.(EXTYPE)) GO TO 32741 ASSIGN 32739 TO I32740 GO TO 32740 32739 GO TO 32743 32741 IF((TCOND).NE.(EXTYPE)) GO TO 32738 ASSIGN 32737 TO I32740 GO TO 32740 32737 GO TO 32743 32738 IF((TSELCT).NE.(EXTYPE)) GO TO 32736 ASSIGN 32734 TO I32735 GO TO 32735 32734 IF(.NOT.(NUNITS.GT.1)) GO TO 32733 NUNITS=1 CURSOR=USTART(2) ASSIGN 32731 TO I32732 GO TO 32732 32731 ASSIGN 32730 TO I32740 GO TO 32740 32730 CONTINUE 32733 GO TO 32743 32736 ASSIGN 32729 TO I32735 GO TO 32735 32729 CONTINUE 32743 GO TO 32745 32744 IF((TFIN).NE.(CLASS)) GO TO 32728 ASSIGN 32727 TO I32740 GO TO 32740 32727 GO TO 32745 32728 IF((TEND).NE.(CLASS)) GO TO 32726 GO TO 32745 32726 IF((TELSE).NE.(CLASS)) GO TO 32725 ASSIGN 32723 TO I32724 GO TO 32724 32723 GO TO 32745 32725 IF((TTO).NE.(CLASS)) GO TO 32722 CSAVE=CURSOR ASSIGN 32720 TO I32721 GO TO 32721 32720 IF(.NOT.(FOUND)) GO TO 32718 ASSIGN 32717 TO I32724 GO TO 32724 32717 GO TO 32719 32718 ERSTOP=ERSTOP+1 ERRSTK(ERSTOP)=5 ASSIGN 32715 TO I32716 GO TO 32716 32715 SFLX(1)=CSAVE CALL CATSTR(SFLX,SDUM) CURSOR=CSAVE ASSIGN 32714 TO I32732 GO TO 32732 32714 ASSIGN 32713 TO I32721 GO TO 32721 32713 CONTINUE 32719 GO TO 32745 32722 IF((TCEXP).NE.(CLASS)) GO TO 32712 ASSIGN 32711 TO I32735 GO TO 32735 32711 CONTINUE 32712 CONTINUE 32745 IF(ERSTOP.GT.0) CLASS=0 LSTLEV=LEVEL RETURN 32710 CURSOR=CURSOR+1 CPOS=CPOS+1 IF(.NOT.(CPOS.GT.NCHPWD)) GO TO 32709 CWD=CWD+1 CPOS=1 32709 IF(.NOT.(CURSOR.GT.SFLX(1))) GO TO 32707 CHTYPE=TEOL GO TO 32708 32707 CALL GETCH(SFLX(CWD),CPOS,CH) CHTYPE=CHTYP(CH) 32708 GO TO I32710 32706 LSTLEV=LEVEL IF(.NOT.(LSTLEV.EQ.0)) GO TO 32704 CALL PUT(BLN,SB,LISTCL) GO TO 32705 32704 CALL CPYSTR(SLIST,SB6) DO 32703 I=1,LSTLEV CALL CATSTR(SLIST,SSPACR) 32703 CONTINUE IF(.NOT.(SLIST(1).GT.WWIDTH)) GO TO 32701 CALL PUT(BLN,SP,LISTCL) GO TO 32702 32701 CALL PUT(BLN,SLIST,LISTCL) 32702 CONTINUE 32705 BLN=0 GO TO I32706 32700 CURSOR=1 LINENO=LINENO-1 ASSIGN 32699 TO I32732 GO TO 32732 32699 INDENT=.TRUE. I=2 GO TO 32697 32698 IF(.NOT.(I.LE.6.AND.INDENT)) GO TO 32696 32697 ASSIGN 32695 TO I32710 GO TO 32710 32695 IF (CHTYPE.NE.TBLANK.AND.CHTYPE.NE.TEOL) INDENT=.FALSE. I=I+1 GO TO 32698 32696 IF(.NOT.(INDENT)) GO TO 32693 LSTLEV=LEVEL CLASS=0 ASSIGN 32691 TO I32692 GO TO 32692 32691 GO TO 32694 32693 CALL PUT(LINENO,SFLX,LISTCL) 32694 GO TO I32700 32690 CALL PUT(0,SB,LISTCL) CALL PUT(0,SDASH,LISTCL) CALL PUT(0,SB,LISTCL) GO TO I32690 32692 IF(.NOT.(CLASS.EQ.TTO)) GO TO 32689 ASSIGN 32688 TO I32690 GO TO 32690 32688 CONTINUE 32689 IF (SFLX(1).LT.7) CALL CATSTR(SFLX,SB7) CALL CPYSUB(SLIST,SFLX,1,6) IF(LSTLEV.EQ.0) GO TO 32687 DO 32686 I=1,LSTLEV CALL CATSTR(SLIST,SSPACR) 32686 CONTINUE 32687 IF(.NOT.(CLASS.EQ.TFIN)) GO TO 32685 SLIST(1)=SLIST(1)-SSPACR(1) CALL CATSTR(SLIST,SFSPCR) 32685 CALL CATSUB(SLIST,SFLX,7,SFLX(1)-6) IF (SLIST(1).GT.WWIDTH) CALL CPYSTR(SLIST,SFLX) IF(.NOT.(ERLST)) GO TO 32683 CALL PUT(LINENO,SLIST,ERRCL) ERLST=.FALSE. GO TO 32684 32683 CALL PUT(LINENO,SLIST,LISTCL) 32684 GO TO I32692 32757 GO TO 32681 32682 IF(FOUND) GO TO 32680 32681 CALL GET(LINENO,SFLX,ENDFIL) IF(.NOT.(FIRST)) GO TO 32679 32678 IF(SFLX(1).GT.0.OR.ENDFIL) GO TO 32677 CALL GET(LINENO,SFLX,ENDFIL) GO TO 32678 32677 FIRST=.FALSE. IF(ENDFIL) NOPGM=.TRUE. 32679 IF(.NOT.(ENDFIL)) GO TO 32676 CALL CPYSTR(SFLX,SEND) LINENO=0 32676 CALL GETCH(SFLX(2),1,CH) IF(.NOT.(SFLX(1).EQ.0)) GO TO 32674 BLN=LINENO ASSIGN 32673 TO I32706 GO TO 32706 32673 FOUND=.FALSE. GO TO 32675 32674 IF(.NOT.(CH.EQ.CHC)) GO TO 32672 ASSIGN 32671 TO I32700 GO TO 32700 32671 FOUND=.FALSE. GO TO 32675 32672 FOUND=.TRUE. 32675 GO TO 32682 32680 GO TO I32757 32732 CURSOR=CURSOR-1 CWD=(CURSOR-1)/NCHPWD+2 CPOS=CURSOR-(CWD-2)*NCHPWD ASSIGN 32670 TO I32710 GO TO 32710 32670 GO TO I32732 32716 IF(SAVED) GO TO 32669 SAVED=.TRUE. HOLDNO=LINENO CALL CPYSTR(SHOLD,SFLX) 32669 GO TO I32716 32751 ASSIGN 32668 TO I32710 GO TO 32710 32668 IF(.NOT.(CHTYPE.EQ.TEOL)) GO TO 32666 CONT=.FALSE. GO TO 32667 32666 IF(.NOT.(CH.EQ.CHZERO.OR.CH.EQ.CHSPAC)) GO TO 32665 CONT=.FALSE. GO TO 32667 32665 CONT=.TRUE. 32667 GO TO I32751 32735 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32664 ASSIGN 32663 TO I32710 GO TO 32710 32663 GO TO 32735 32664 START=CURSOR IF(.NOT.(CHTYPE.NE.TLP)) GO TO 32662 ERSTOP=ERSTOP+1 ERRSTK(ERSTOP)=3 ASSIGN 32661 TO I32716 GO TO 32716 32661 CALL CPYSTR(SST,SFLX) SFLX(1)=START-1 CALL CATSTR(SFLX,SLP) CALL CATSUB(SFLX,SST,START,SST(1)-START-1) 32662 PCNT=1 FOUND=.TRUE. GO TO 32659 32660 IF(PCNT.EQ.0.OR..NOT.FOUND) GO TO 32658 32659 ASSIGN 32657 TO I32710 GO TO 32710 32657 IF((TRP).NE.(CHTYPE)) GO TO 32655 PCNT=PCNT-1 GO TO 32656 32655 IF((TLP).NE.(CHTYPE)) GO TO 32654 PCNT=PCNT+1 GO TO 32656 32654 IF((TEOL).NE.(CHTYPE)) GO TO 32653 FOUND=.FALSE. 32653 CONTINUE 32656 GO TO 32660 32658 IF(FOUND) GO TO 32652 ERSTOP=ERSTOP+1 ERRSTK(ERSTOP)=4 ASSIGN 32651 TO I32716 GO TO 32716 32651 DO 32650 I=1,PCNT CALL CATSTR(SFLX,SRP) 32650 CONTINUE CURSOR=SFLX(1) ASSIGN 32649 TO I32732 GO TO 32732 32649 CONTINUE 32652 ASSIGN 32648 TO I32710 GO TO 32710 32648 NUNITS=NUNITS+1 UTYPE(NUNITS)=UEXP USTART(NUNITS)=START ULEN(NUNITS)=CURSOR-START CALL CPYSUB(SST,SFLX,START,CURSOR-START) IF(STREQ(SST,SOWSE)) UTYPE(NUNITS)=UOWSE ASSIGN 32647 TO I32724 GO TO 32724 32647 GO TO I32735 32740 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32646 ASSIGN 32645 TO I32710 GO TO 32710 32645 GO TO 32740 32646 IF(.NOT.(CHTYPE.NE.TEOL)) GO TO 32644 ERSTOP=ERSTOP+1 ERRSTK(ERSTOP)=2 ASSIGN 32643 TO I32716 GO TO 32716 32643 SFLX(1)=CURSOR-1 32644 GO TO I32740 32747 ASSIGN 32642 TO I32710 GO TO 32710 32642 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32641 ASSIGN 32640 TO I32710 GO TO 32710 32640 GO TO 32642 32641 IF((TLETTR).NE.(CHTYPE)) GO TO 32638 START=CURSOR INVOKE=.FALSE. BADCH=.FALSE. GO TO 32636 32637 IF(BADCH) GO TO 32635 32636 ASSIGN 32634 TO I32710 GO TO 32710 32634 IF(.NOT.(CHTYPE.LE.TDIGIT)) GO TO 32632 GO TO 32633 32632 IF(.NOT.(CHTYPE.EQ.THYPHN)) GO TO 32631 INVOKE=.TRUE. GO TO 32633 32631 BADCH=.TRUE. 32633 GO TO 32637 32635 LEN=CURSOR-START IF(.NOT.(INVOKE)) GO TO 32629 CLASS=TEXEC EXTYPE=TINVOK NUNITS=1 UTYPE(1)=UPINV USTART(1)=START ULEN(1)=LEN GO TO 32630 32629 CALL CPYSUB(SST,SFLX,START,LEN) CLASS=TEXEC EXTYPE=TFORT IF((2).NE.(SST(1))) GO TO 32627 IF(.NOT.(STREQ(SST,KIF))) GO TO 32625 EXTYPE=TIF GO TO 32626 32625 IF(.NOT.(STREQ(SST,KTO))) GO TO 32624 CLASS=TTO GO TO 32626 32624 IF(.NOT.(STREQ(SST,KDO))) GO TO 32623 32622 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32621 ASSIGN 32620 TO I32710 GO TO 32710 32620 GO TO 32622 32621 IF(.NOT.(CHTYPE.EQ.TDIGIT)) GO TO 32618 EXTYPE=TFORT GO TO 32619 32618 EXTYPE=TDO 32619 CONTINUE 32623 CONTINUE 32626 GO TO 32628 32627 IF((3).NE.(SST(1))) GO TO 32617 IF(.NOT.(STREQ(SST,KFIN))) GO TO 32615 CLASS=TFIN GO TO 32616 32615 IF(.NOT.(STREQ(SST,KEND))) GO TO 32614 IF (CHTYPE.EQ.TEOL) CLASS=TEND 32614 CONTINUE 32616 GO TO 32628 32617 IF((4).NE.(SST(1))) GO TO 32613 IF(.NOT.(STREQ(SST,KWHEN))) GO TO 32611 EXTYPE=TWHEN GO TO 32612 32611 IF(.NOT.(STREQ(SST,KELSE))) GO TO 32610 CLASS=TELSE 32610 CONTINUE 32612 GO TO 32628 32613 IF((5).NE.(SST(1))) GO TO 32609 IF(.NOT.(STREQ(SST,KWHILE))) GO TO 32607 EXTYPE=TWHILE GO TO 32608 32607 IF(.NOT.(STREQ(SST,KUNTIL))) GO TO 32606 EXTYPE=TUNTIL 32606 CONTINUE 32608 GO TO 32628 32609 IF((6).NE.(SST(1))) GO TO 32605 IF(.NOT.(STREQ(SST,KREPT))) GO TO 32603 32602 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32601 ASSIGN 32600 TO I32710 GO TO 32710 32600 GO TO 32602 32601 START=CURSOR 32599 IF(.NOT.(CHTYPE.EQ.TLETTR)) GO TO 32598 ASSIGN 32597 TO I32710 GO TO 32710 32597 GO TO 32599 32598 LEN=CURSOR-START CALL CPYSUB(SST,SFLX,START,LEN) IF(.NOT.(STREQ(SST,KWHILE))) GO TO 32595 EXTYPE=TRWHIL GO TO 32596 32595 IF(.NOT.(STREQ(SST,KUNTIL))) GO TO 32594 EXTYPE=TRUNTL 32594 CONTINUE 32596 GO TO 32604 32603 IF(.NOT.(STREQ(SST,KSELCT))) GO TO 32593 EXTYPE=TSELCT GO TO 32604 32593 IF(.NOT.(STREQ(SST,KUNLES))) GO TO 32592 EXTYPE=TUNLES 32592 CONTINUE 32604 GO TO 32628 32605 IF((11).NE.(SST(1))) GO TO 32591 IF (STREQ(SST,KCOND)) EXTYPE=TCOND 32591 CONTINUE 32628 CONTINUE 32630 GO TO 32639 32638 IF((TLP).NE.(CHTYPE)) GO TO 32590 CLASS=TCEXP GO TO 32639 32590 CLASS=TEXEC EXTYPE=TFORT 32639 GO TO I32747 32721 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32589 ASSIGN 32588 TO I32710 GO TO 32710 32588 GO TO 32721 32589 FOUND=.FALSE. IF(.NOT.(CHTYPE.EQ.TLETTR)) GO TO 32587 START=CURSOR GO TO 32585 32586 IF(CHTYPE.GT.THYPHN) GO TO 32584 32585 ASSIGN 32583 TO I32710 GO TO 32710 32583 IF(CHTYPE.EQ.THYPHN) FOUND=.TRUE. GO TO 32586 32584 CONTINUE 32587 IF(.NOT.(FOUND)) GO TO 32582 NUNITS=NUNITS+1 UTYPE(NUNITS)=UPINV USTART(NUNITS)=START ULEN(NUNITS)=CURSOR-START 32582 GO TO I32721 32724 IF(.NOT.(CHTYPE.EQ.TBLANK)) GO TO 32581 ASSIGN 32580 TO I32710 GO TO 32710 32580 GO TO 32724 32581 IF(CHTYPE.EQ.TEOL) GO TO 32579 CSAVE=CURSOR ASSIGN 32578 TO I32721 GO TO 32721 32578 IF(.NOT.(FOUND)) GO TO 32576 ASSIGN 32575 TO I32740 GO TO 32740 32575 GO TO 32577 32576 NUNITS=NUNITS+1 UTYPE(NUNITS)=UFORT USTART(NUNITS)=CSAVE ULEN(NUNITS)=SFLX(1)+1-CSAVE 32577 CONTINUE 32579 GO TO I32724 32753 FLXNO=0 PASS=.FALSE. DO 32574 I=1,5 ASSIGN 32573 TO I32710 GO TO 32710 32573 IF((TBLANK).NE.(CHTYPE)) GO TO 32571 GO TO 32572 32571 IF((TDIGIT).NE.(CHTYPE)) GO TO 32570 FLXNO=FLXNO*10+CH-CHZERO GO TO 32572 32570 IF((TEOL).NE.(CHTYPE)) GO TO 32569 GO TO 32572 32569 PASS=.TRUE. 32572 CONTINUE 32574 CONTINUE GO TO I32753 END