SUBROUTINE PVR2 (INDEX, FLAG) INTEGER INDEX, FLAG INTEGER ADDR, ADRFLG, CUROP, NEXTOP, CFLAG INTEGER PI, XBBL, XA, XF, XZERO, DPVFLG INTEGER LC, LCI, LODLCI, LODLCV, LDLCVO, MAXLCV INTEGER NEXT, NUMBER, I, IOTYPE INTEGER J, K, L, LABNLX, M, N INTEGER PSYMB, SYMBOL, TOP, VALFLG, QVALUE INTEGER OPTOPX, OPNXTX, TOPX, NEXTX INTEGER DUMMY, OVCHN, PEEKS INTEGER LO, CI, CO, LOGICF, LOCSUP INTEGER VAREF, INPUTJ, LCTS, CRUCNT, FLTCNT INTEGER ICLP05 LOGICAL ENDOK,CONEND COMMON /LOGOS/ ADDR, ADRFLG, CUROP, NEXTOP, CFLAG COMMON /LOGOS/ PI, XBBL, XA, XF, XZERO, DPVFLG COMMON /LOGOS/ LC, LCI, LODLCI, LODLCV, LDLCVO, MAXLCV COMMON /LOGOS/ NEXT, NUMBER, I, IOTYPE COMMON /LOGOS/ J, K, L, LABNLX, M, N COMMON /LOGOS/ PSYMB, SYMBOL, TOP, VALFLG, QVALUE COMMON /LOGOS/ OPTOPX, OPNXTX, TOPX, NEXTX COMMON /LOGOS/ DUMMY, OVCHN, PEEKS COMMON /LOGOS/ LO, CI, CO, LOGICF, LOCSUP COMMON /LOGOS/ VAREF, INPUTJ, LCTS, CRUCNT, FLTCNT COMMON /LOGOS/ ICLP05 COMMON /LOGOS/ ENDOK,CONEND INTEGER WF1,WF2,WF3,WF4,WF5,WF6,WF7,WF8,WF9,WF10,WF11,WF12,WF13,W 1F14,WF15,WF16,WF17 INTEGER ICLP16 COMMON / WF / WF1,WF2,WF3,WF4,WF5,WF6,WF7,WF8,WF9,WF10,WF11,WF12 1,WF13,WF14,WF15,WF16,WF17 COMMON / WF / ICLP16 INTEGER NINE INTEGER COMMA, SEMIC, PERIOD, COLON, FOR, DOOP, WHILE INTEGER RBRACE, LBRACE, RETOP, CRUTCH INTEGER LPAREN, RPAREN, LBK, RBK INTEGER EQUAL, NEQUAL, GTR, GEQ, LESS, LESSEQ, ARROW INTEGER PLUS, MINUS, MULT, DIVIDE, MODOP INTEGER OROP, ANDOP, AOROP, XOROP, AANDOP INTEGER LSHIFT, RSHIFT, LCYCLE, RCYCLE, ALSHFT, ARSHFT INTEGER NEG, UPARO, DNARO, COM INTEGER LOC, GIZZY, QUOTE, ZRL, TEMPL INTEGER SP, DP, ST, HEX INTEGER ATSIGN INTEGER ICLP06 COMMON /OPERS/ NINE COMMON /OPERS/ COMMA, SEMIC, PERIOD, COLON, FOR, DOOP, WHILE COMMON /OPERS/ RBRACE, LBRACE, RETOP, CRUTCH COMMON /OPERS/ LPAREN, RPAREN, LBK, RBK COMMON /OPERS/ EQUAL, NEQUAL, GTR, GEQ, LESS, LESSEQ, ARROW COMMON /OPERS/ PLUS, MINUS, MULT, DIVIDE, MODOP COMMON /OPERS/ OROP, ANDOP, AOROP, XOROP, AANDOP COMMON /OPERS/ LSHIFT, RSHIFT, LCYCLE, RCYCLE, ALSHFT, ARSHFT COMMON /OPERS/ NEG, UPARO, DNARO, COM COMMON /OPERS/ LOC, GIZZY, QUOTE, ZRL, TEMPL COMMON /OPERS/ SP, DP, ST, HEX COMMON /OPERS/ ATSIGN COMMON /OPERS/ ICLP06 INTEGER WOPTR, WO (64), TLI, TL (128) INTEGER BO, SS, SS2, NRFCH COMMON /SCR1/ WOPTR, WO, TLI, TL COMMON /SCR1/ BO, SS, SS2, NRFCH INTEGER LEVELB, NLEVEL, LLEVEL, ILEVEL, CLEVEL INTEGER ICLP04 COMMON /LEVELS/ LEVELB, NLEVEL, LLEVEL, ILEVEL, CLEVEL COMMON /LEVELS/ ICLP04 INTEGER STK (20, 13) INTEGER NAMEX (40) INTEGER OPX, STKSIZ, OCBIT, FUNBIT, SBIAS INTEGER ICLP14 COMMON /SDEFS/ STK, OPX, STKSIZ, OCBIT, FUNBIT, SBIAS COMMON /SDEFS/ ICLP14 EQUIVALENCE (STK (1,1), NAMEX (1)) INTEGER MODE (40), SUBX (20), SUBXM (20), BIAS (40) EQUIVALENCE (STK (1, 3), MODE (1)) EQUIVALENCE (STK (1, 2), SUBX (1)) EQUIVALENCE (STK (1, 4), SUBXM (1)) EQUIVALENCE (STK (1, 5), BIAS (1)) INTEGER LOCFLG (20) EQUIVALENCE (STK (1, 7), LOCFLG (1)) INTEGER PLEVEL, STOPS (20) INTEGER CNLSID (9), CNLTLI (9), CNLEND (9) INTEGER CLX, CPLOC (30) INTEGER NESTX, PNESTX INTEGER RELLEV, RELCNT, TRUEF LOGICAL RELPAS INTEGER CMPFLG INTEGER ILB INTEGER BRCT, BROK, TNESTX COMMON /COMP/ PLEVEL, STOPS COMMON /COMP/ CNLSID, CNLTLI, CNLEND COMMON /COMP/ CLX, CPLOC COMMON /COMP/ NESTX, PNESTX COMMON /COMP/ RELLEV, RELCNT, TRUEF COMMON /COMP/ RELPAS COMMON /COMP/ CMPFLG COMMON /COMP/ ILB COMMON /COMP/ BRCT, BROK, TNESTX INTEGER QUOTEX INTEGER CONTF INTEGER CONTRL INTEGER HEAD INTEGER EJECT INTEGER BLANK INTEGER SLASH INTEGER CARDC INTEGER FLINCT (8) INTEGER EOCC INTEGER ENDCRD (3) INTEGER RECORD (66) INTEGER RECPTR INTEGER SOURCE (150) INTEGER SRCEND INTEGER SLEN INTEGER TF (3) COMMON /SRCE/ QUOTEX COMMON /SRCE/ CONTF COMMON /SRCE/ CONTRL COMMON /SRCE/ HEAD COMMON /SRCE/ EJECT COMMON /SRCE/ BLANK COMMON /SRCE/ SLASH COMMON /SRCE/ CARDC COMMON /SRCE/ FLINCT COMMON /SRCE/ EOCC COMMON /SRCE/ ENDCRD COMMON /SRCE/ RECORD COMMON /SRCE/ RECPTR COMMON /SRCE/ SOURCE COMMON /SRCE/ SRCEND COMMON /SRCE/ SLEN COMMON /SRCE/ TF INTEGER BRACEX, SELX, LSX, SELXB INTEGER FUNCNT, FSCNT, FRCNT, FUNVAL INTEGER NRFLS, ARGSIZ, PARCNT INTEGER BSTACK (10), SUBENT (40) INTEGER FLS (6), PARSAV, FLSAVE (6) INTEGER WHSTRT (30), WHLOW (10), WHHIGH (10) INTEGER LOOPT (10), LOOPE (10), LOOPF (10) COMMON /BRACE/ BRACEX, SELX, LSX, SELXB COMMON /BRACE/ FUNCNT, FSCNT, FRCNT, FUNVAL COMMON /BRACE/ NRFLS, ARGSIZ, PARCNT COMMON /BRACE/ WHSTRT, BSTACK, SUBENT COMMON /BRACE/ FLS, PARSAV, FLSAVE EQUIVALENCE (WHSTRT, LOOPT) EQUIVALENCE (WHLOW, LOOPE, WHSTRT (11)) EQUIVALENCE (WHHIGH, LOOPF, WHSTRT (21)) LOGICAL MSEEN, SMSEEN, ZFLAG INTEGER SMODE, TPFLAG, DEFMOD, LEVEL INTEGER STOAC, OP COMMON /BPO/ MSEEN, SMSEEN, ZFLAG COMMON /BPO/ SMODE, TPFLAG, DEFMOD, LEVEL COMMON /BPO/ STOAC, OP INTEGER EXFLT, FLTNR COMMON /FLTS/ EXFLT, FLTNR INTEGER ADCINX INTEGER ANDINX INTEGER ASLINX INTEGER BITINX INTEGER CMPINX INTEGER CPXINX INTEGER CPYINX INTEGER DECINX INTEGER EORINX INTEGER INCINX INTEGER JMPINX INTEGER JSRINX INTEGER LDAINX INTEGER LDXINX INTEGER LDYINX INTEGER LSRINX INTEGER ORAINX INTEGER ROLINX INTEGER RORINX INTEGER SBCINX INTEGER STAINX INTEGER STXINX INTEGER STYINX INTEGER ICLP07 COMMON /OPINX/ ADCINX, ANDINX, ASLINX, BITINX, CMPINX COMMON /OPINX/ CPXINX, CPYINX, DECINX, EORINX, INCINX COMMON /OPINX/ JMPINX, JSRINX, LDAINX, LDXINX, LDYINX COMMON /OPINX/ LSRINX, ORAINX, ROLINX, RORINX, SBCINX COMMON /OPINX/ STAINX, STXINX, STYINX COMMON /OPINX/ ICLP07 INTEGER CLRACV INTEGER CLRACX INTEGER CLRSTA INTEGER TRAREG INTEGER SAVREG INTEGER CTFREE INTEGER SETREG INTEGER ICLP11 COMMON /RMCODE/ CLRACV, CLRACX, CLRSTA, TRAREG, SAVREG COMMON /RMCODE/ CTFREE, SETREG COMMON /RMCODE/ ICLP11 INTEGER TS FLAG = 0 GO TO (100, 10, 50, 70), INDEX 100 LEVELB = LLEVEL IF (.NOT. (NESTX .NE. 1))GO TO 13016 EXFLT = 0 DO 13018 I = 2, NESTX EXFLT = EXFLT + 3 - CNLSID (I-1) 13018 CONTINUE CALL SET (59, SOURCE, EXFLT) CALL SET (46, SOURCE (EXFLT+1), 4) SRCEND = EXFLT + 3 CALL FAULTP (25) J = 1 FLAG = 1 GO TO 13017 13016 CONTINUE IF (.NOT. (BRACEX .GT. 1))GO TO 13020 EXFLT = BRACEX - 1 CALL SET (96, SOURCE, EXFLT) CALL SET (46, SOURCE (BRACEX), 4) SRCEND = EXFLT + 4 CALL FAULTP (12) J = 1 FLAG = 1 GO TO 13021 13020 CONTINUE CALL WRBLOK J = SRCEND 13021 CONTINUE 13017 CONTINUE RETURN 10 IF (.NOT. (NAMEX (OPX) .NE. 0 .AND. STOAC .EQ. 0))GO TO 13022 IF (.NOT. (LOCFLG (OPX) .NE. 0))GO TO 13024 IF (SUBX (OPX) .NE. 0) CALL FAULTP (31) CALL BLDBLK (BIAS (OPX), WF6) CALL BLDBLK (NAMEX (OPX), WF7) GO TO 13025 13024 CONTINUE IF (CFLAG .NE. 0) CALL FAULTP (64) CALL GENT (1) 13025 CONTINUE 13022 CONTINUE NEXTX = OPX STOAC = 0 RETURN 50 LOOPF (LSX) = NEXTOP IF (.NOT. (NEXTOP .EQ. DOOP))GO TO 13026 CALL DEFTL (TLI) CALL REGMAN (CLRACV, 0, 0) CALL SET (0, FLSAVE, 6) WHSTRT (LSX) = TLI TLI = TLI + 1 WHLOW (LSX) = - (NESTX + 1) BSTACK (BRACEX) = 0 IF (.NOT. (BRACEX .EQ. 9))GO TO 13028 CALL FAULTP (59) GO TO 13029 13028 CONTINUE BRACEX = BRACEX + 1 13029 CONTINUE 13026 CONTINUE LSX = LSX + 1 RETURN 70 OPX = OPX - 1 NEXTX = OPX IF (.NOT. (NAMEX (NEXTX) .NE. 0))GO TO 13030 CALL MSTAK (NEXTX, NEXTX+2) CALL SETUP (LDAINX, NEXTX) CALL GEN (-1, NEXTX, -2) CALL GEN (COM + 1, NEXTX, NEXTX) CALL GEN (-1, -2, -2) 13030 CONTINUE CONTINUE 13032 CONTINUE IF (.NOT.(NEXTOP .EQ. COMMA))GO TO 13033 CALL ADVAN IF (NAMEX (OPX) .NE. 0) CALL FAULTP (67) GO TO 13032 13033 CONTINUE TS = BRACEX - 1 13036 IF (.NOT.(TS .GT. 0))GO TO 13035 IF (.NOT. (BSTACK (TS) .GT. 0))GO TO 13037 IF (.NOT. (NEXTOP .EQ. PERIOD))GO TO 13039 CALL BLDBLK (96, WF4) IF (NESTX .NE. 1) FLAG = 1 GO TO 13040 13039 CONTINUE IF (.NOT. (NEXTOP .NE. RBRACE .OR. TS .NE. BRACEX - 1))GO TO 13041 CALL FAULTP (67) 13041 CONTINUE STOAC = 1 RETURN 13040 CONTINUE GO TO 13038 13037 CONTINUE TS = TS - 1 GO TO 13036 13035 CONTINUE CALL FAULTP (67) 13038 CONTINUE STOAC = 0 RETURN END