SUBROUTINE LCOMP (FUNC) INTEGER FUNC INTEGER ILBRET, SCRET INTEGER OPTS1, LDROP INTEGER TS, BROKTS INTEGER COMPOP (6) INTEGER JMP 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 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 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)) 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 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 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 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 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 GENRET INTEGER MODEX INTEGER RAWMDX INTEGER SPTR INTEGER TSTSTK INTEGER SWAP INTEGER TOPDP INTEGER NEXTDP INTEGER TOPSP INTEGER NEXTSP INTEGER SAVCAL INTEGER OUT INTEGER GETSP INTEGER SMODEX INTEGER SETX INTEGER ICLP02 COMMON /GENC/ GENRET COMMON /GENC/ MODEX COMMON /GENC/ RAWMDX COMMON /GENC/ SPTR COMMON /GENC/ TSTSTK COMMON /GENC/ SWAP COMMON /GENC/ TOPDP COMMON /GENC/ NEXTDP COMMON /GENC/ TOPSP COMMON /GENC/ NEXTSP COMMON /GENC/ SAVCAL COMMON /GENC/ OUT COMMON /GENC/ GETSP COMMON /GENC/ SMODEX COMMON /GENC/ SETX COMMON /GENC/ ICLP02 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 DATA JMP /76/ DATA COMPOP / 18, 17, 22, 21, 20, 19/ GO TO (100, 200, 300), FUNC 100 CALL GENER (SETX) IF (.NOT. (CNLSID (NESTX) .EQ. 0))GO TO 13000 CNLSID (NESTX) = 1 CNLEND (NESTX) = 0 PLEVEL = PLEVEL + 1 STOPS (PLEVEL) = CLX 13000 CONTINUE CMPFLG = CMPFLG + 1 OPTS1 = NEXTOP CALL SSBUF LDROP = 0 ILB = 0 CONTINUE 13002 CONTINUE IF (.NOT.(OPTS1 .EQ. RPAREN))GO TO 13003 LDROP = LDROP + 1 CALL PEEKFO OPTS1 = PEEKS GO TO 13002 13003 CONTINUE IF (.NOT. (OPTS1 .EQ. OROP))GO TO 13004 TRUEF = 1 OP = OP - EQUAL OP = COMPOP (OP + 1) GO TO 13005 13004 CONTINUE TRUEF = -1 IF (.NOT. (OPTS1 .EQ. ANDOP))GO TO 13006 PLEVEL = PLEVEL + 1 STOPS (PLEVEL) = CLX GO TO 13007 13006 CONTINUE IF (.NOT. (OPTS1 .EQ. COLON))GO TO 13008 PNESTX = NESTX + 1 GO TO 13009 13008 CONTINUE CALL FAULTP (34) 13009 CONTINUE 13007 CONTINUE 13005 CONTINUE IF (.NOT. (OPTS1 .EQ. COLON))GO TO 13010 CALL PEEKFO IF (.NOT. (PEEKS .EQ. PERIOD .OR. PEEKS .EQ. SEMIC .OR. PEEKS .EQ. 1 RBRACE))GO TO 13012 ILB = 1 TRUEF = 1 OP = OP - EQUAL OP = COMPOP (OP + 1) 13012 CONTINUE 13010 CONTINUE CALL MSTAK (NEXTX, NEXTX+2) CALL SETUP (LDAINX, NEXTX) CALL SETUP (LDAINX, TOPX) CALL GEN (-1, NEXTX, -2) CALL GEN (OP, NEXTX, TOPX) CALL GEN (-1, -2, -2) CALL GENER (OUT) IF (.NOT. (OPTS1 .EQ. COLON))GO TO 13014 CALL REGLEV (1) 13014 CONTINUE PLEVEL = PLEVEL - LDROP ILBRET=1 IF (OPTS1 .EQ. OROP) GO TO 500 GO TO 550 110 PLEVEL = PLEVEL + LDROP IF (OPTS1 .EQ. ANDOP) PLEVEL = PLEVEL - 1 CALL REGMAN (CLRSTA, 0, 0) RETURN 200 IF (.NOT. (RELCNT + 1 .NE. CMPFLG))GO TO 13016 CALL REGLEV (1) CALL FAULTP (36) 13016 CONTINUE CMPFLG = 0 RELCNT = 0 STOAC = 0 IF (.NOT. (NESTX .EQ. 9))GO TO 13018 CALL FAULTP (37) GO TO 13019 13018 CONTINUE NESTX = NESTX + 1 IF (.NOT. (LOOPF (LSX-1) .EQ. WHILE))GO TO 13020 LSX = LSX - 1 WHLOW (LSX - 1) = SELX TS = STOPS (PLEVEL) + 1 DO 13022 TS = TS, CLX L = CPLOC (TS - 1) IF (.NOT. (L .LT. 0))GO TO 13024 CPLOC (TS - 1) = 0 SUBENT (SELX) = -L CALL STSLX (2) 13024 CONTINUE 13022 CONTINUE WHHIGH (LSX - 1) = SELX CNLSID (NESTX - 1) = 2 CNLTLI (NESTX - 1) = 0 CNLEND (NESTX - 1) = 0 GO TO 300 13020 CONTINUE 13019 CONTINUE RETURN 300 TNESTX = NESTX - 1 IF (.NOT. (CNLSID (TNESTX) .LT. 2))GO TO 13026 CNLSID (TNESTX) = 2 CALL REGLEV (2) IF (.NOT. (NEXTOP .EQ. SEMIC))GO TO 13028 CALL PEEK IF (.NOT. (PEEKS .NE. SEMIC))GO TO 13030 TS = TLI CNLTLI (TNESTX) = TS TLI = TLI + 1 CALL BLDOP (JMP, WF8, 0, TS, WF9) 13030 CONTINUE 13028 CONTINUE IF (CNLEND (TNESTX) + 129 .GE. LC) BROK = BROK + 1 BRCT = BRCT + 1 CNLEND (TNESTX) = NEXTOP ILBRET=2 GO TO 500 310 CONTINUE GO TO 13027 13026 CONTINUE NESTX = TNESTX PNESTX = NESTX IF (PNESTX .EQ. 1) CLX = 2 CNLSID (NESTX) = 0 TS = CNLTLI (NESTX) IF (.NOT. (TS .NE. 0))GO TO 13032 CNLTLI (NESTX) = 0 CALL DEFTL (TS) 13032 CONTINUE IF (.NOT. (CNLEND (NESTX) .EQ. SEMIC))GO TO 13034 CALL REGLEV (3) CALL SET (0, FLSAVE, 6) 13034 CONTINUE PLEVEL = PLEVEL - 1 13027 CONTINUE RETURN 500 SCRET=1 I = STOPS (PLEVEL) 13038 IF (.NOT.(I .LT. CLX))GO TO 13037 L = -CPLOC (I) IF (L .GT. 0) GO TO 575 510 I = I + 1 GO TO 13038 13037 CONTINUE GOTO (110,310),ILBRET 550 SCRET=2 I = STOPS (PLEVEL) 13041 IF (.NOT.(I .LT. CLX))GO TO 13040 L = CPLOC (I) IF (L .GT. 0) GO TO 575 560 I = I + 1 GO TO 13041 13040 CONTINUE GOTO (110,310),ILBRET 575 CALL DEFTL (L) CALL REGLEV (5) CALL SET (0, FLSAVE, 6) CPLOC (I) = 0 GOTO (510,560),SCRET END