SUBROUTINE SETUP (FUNC, INDX) INTEGER FUNC, INDX 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 NI, NJ, NK INTEGER NSIZE INTEGER NLX, FNLX, REMNLX, OVNLX, TNAME INTEGER NLSTRT, NLSTOP, NLSIZE, SRCHST INTEGER NTSTRT INTEGER NTSTOP INTEGER NTSIZE INTEGER PARFLG INTEGER SPARFL INTEGER NLWRDS INTEGER TX INTEGER NLENO INTEGER STDMD INTEGER MSHIFT INTEGER REGCNT INTEGER NULLX INTEGER STPTRX INTEGER SPMODE INTEGER DPMODE INTEGER SPECMD INTEGER ENFLAG INTEGER DFINED INTEGER CVALUE INTEGER NLXLCI INTEGER ENEXTD INTEGER NAMAT0 INTEGER NAMCON INTEGER NLMODE INTEGER PARBIT INTEGER OPBIT INTEGER LOCALB INTEGER REGBIT INTEGER EXTBIT INTEGER STRBIT INTEGER DPBIT INTEGER CBIT INTEGER PBIT INTEGER EPBIT INTEGER IOBIT INTEGER ARBIT INTEGER EXDBIT INTEGER TPLBIT INTEGER USEBIT INTEGER LCMASK INTEGER MDMASK INTEGER NAMLOC, REGNUM COMMON /NLIST/ NI COMMON /NLIST/ NJ COMMON /NLIST/ NK COMMON /NLIST/ NSIZE COMMON /NLIST/ NLX COMMON /NLIST/ FNLX COMMON /NLIST/ REMNLX COMMON /NLIST/ OVNLX COMMON /NLIST/ TNAME COMMON /NLIST/ NLSTRT COMMON /NLIST/ NLSTOP COMMON /NLIST/ NLSIZE COMMON /NLIST/ SRCHST COMMON /NLIST/ NTSTRT COMMON /NLIST/ NTSTOP COMMON /NLIST/ NTSIZE COMMON /NLIST/ PARFLG COMMON /NLIST/ SPARFL COMMON /NLIST/ NLWRDS COMMON /NLIST/ TX COMMON /NLIST/ NLENO COMMON /NLIST/ STDMD COMMON /NLIST/ MSHIFT COMMON /NLIST/ REGCNT COMMON /NLIST/ NULLX COMMON /NLIST/ STPTRX COMMON /NLIST/ SPMODE COMMON /NLIST/ DPMODE COMMON /NLIST/ SPECMD COMMON /NLIST/ ENFLAG COMMON /NLIST/ DFINED COMMON /NLIST/ CVALUE COMMON /NLIST/ NLXLCI COMMON /NLIST/ ENEXTD COMMON /NLIST/ NAMAT0 COMMON /NLIST/ NAMCON COMMON /NLIST/ NLMODE COMMON /NLIST/ PARBIT COMMON /NLIST/ OPBIT COMMON /NLIST/ LOCALB COMMON /NLIST/ REGBIT COMMON /NLIST/ EXTBIT COMMON /NLIST/ STRBIT COMMON /NLIST/ DPBIT COMMON /NLIST/ CBIT COMMON /NLIST/ PBIT COMMON /NLIST/ EPBIT COMMON /NLIST/ IOBIT COMMON /NLIST/ ARBIT COMMON /NLIST/ EXDBIT COMMON /NLIST/ TPLBIT COMMON /NLIST/ USEBIT COMMON /NLIST/ LCMASK COMMON /NLIST/ MDMASK COMMON /NLIST/ NAMLOC, REGNUM 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 OPCODE (20) EQUIVALENCE (STK (1, 9), OPCODE (1)) INTEGER SUBXB (20), WFOP (20), WFOPND (20) INTEGER SUBOP (20), WFSOP (20) EQUIVALENCE (STK (1, 6), SUBXB (1)) EQUIVALENCE (STK (1, 10), WFOP (1)) EQUIVALENCE (STK (1, 11), WFOPND (1)) EQUIVALENCE (STK (1, 12), SUBOP (1)) EQUIVALENCE (STK (1, 13), WFSOP (1)) 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 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 AREG, XREG, YREG, NRREGS INTEGER STATUS (10), STAREG, STXREG, STYREG INTEGER REGS (10) INTEGER ACTREG (2), ACTLO, ACTHI INTEGER NZREG INTEGER ICLP10 COMMON / REGS / AREG, XREG, YREG, NRREGS COMMON / REGS / STATUS, REGS, ACTREG, NZREG COMMON / REGS / ICLP10 EQUIVALENCE (ACTLO, ACTREG (1)) EQUIVALENCE (ACTHI, ACTREG (2)) EQUIVALENCE (STAREG, STATUS (1)) EQUIVALENCE (STXREG, STATUS (2)) EQUIVALENCE (STYREG, STATUS (3)) 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 LDAZP, LDAABS, LDAIMM INTEGER LDAABY, LDAINY INTEGER LDYZP, LDYABS, LDYIMM INTEGER SETNLX INTEGER TS1, TS2 INTEGER SOPC, SWF, SWFOPN INTEGER SETSTX, SSUBX, STBIAS INTEGER STMODE, SSUBXB, SSUBXM INTEGER SSUBOP, SWFSUB INTEGER SLEFT, SRIGHT, SCTN INTEGER ICLP12 LOGICAL ZPFLAG, STLOC COMMON /SCOM/ LDAZP, LDAABS, LDAIMM COMMON /SCOM/ LDAABY, LDAINY COMMON /SCOM/ LDYZP, LDYABS, LDYIMM COMMON /SCOM/ SETNLX COMMON /SCOM/ TS1, TS2 COMMON /SCOM/ SOPC, SWF, SWFOPN COMMON /SCOM/ SETSTX, SSUBX, STBIAS COMMON /SCOM/ STMODE, SSUBXB, SSUBXM COMMON /SCOM/ SSUBOP, SWFSUB COMMON /SCOM/ SLEFT, SRIGHT, SCTN COMMON /SCOM/ ICLP12 COMMON /SCOM/ ZPFLAG, STLOC INTEGER LNAMEX, LMODE, LOPC, LWFOP, LWFOPN INTEGER RNAMEX, RMODE, ROPC, RWFOP, RWFOPN EQUIVALENCE (LNAMEX, NAMEX (19)) EQUIVALENCE (LMODE, MODE (19)) EQUIVALENCE (LOPC, OPCODE (19)) EQUIVALENCE (LWFOP, WFOP (19)) EQUIVALENCE (LWFOPN, WFOPND (19)) EQUIVALENCE (RNAMEX, NAMEX (20)) EQUIVALENCE (RMODE, MODE (20)) EQUIVALENCE (ROPC, OPCODE (20)) EQUIVALENCE (RWFOP, WFOP (20)) EQUIVALENCE (RWFOPN, WFOPND (20)) INTEGER CTN, CTS, CTB INTEGER NLOPS LOGICAL ZPTST, NLTEST EXTERNAL OLPLO, OLPSB, OLPLC SOPC = LDAZP SWF = WF5 SWFOPN = WF7 SSUBOP = LDYZP SWFSUB = WF5 SETSTX = INDX SETNLX = NAMEX (SETSTX) IF (.NOT. (SETNLX .EQ. 0))GO TO 13000 CALL FAULTP (10) SETNLX = NULLX 13000 CONTINUE STMODE = MODE (SETSTX) SSUBX = SUBX (SETSTX) SSUBXM = SUBXM (SETSTX) STBIAS = BIAS (SETSTX) SSUBXB = 0 STLOC = LOCFLG (SETSTX) .NE. 0 10 IF (.NOT. (NLTEST (SETNLX, REGBIT)))GO TO 13002 TS1 = NLOPS (REGNUM, SETNLX) IF (.NOT. (STATUS (TS1) .EQ. 0 .AND. FUNC .NE. STAINX))GO TO 13004 STATUS (TS1) = SETSTX ACTLO = TS1 IF (.NOT. (STMODE .EQ. DPMODE))GO TO 13006 ACTLO = XREG ACTHI = AREG 13006 CONTINUE 13004 CONTINUE GO TO 1 13002 CONTINUE ZPFLAG = ZPTST (SETNLX, STBIAS) IF ( SSUBX .NE. 0 ) GO TO 6000 IF (NLTEST (SETNLX, PBIT)) GO TO 5000 IF (.NOT. (STLOC))GO TO 13008 SOPC = LDAIMM SWFOPN = WF12 GO TO 1 13008 CONTINUE IF (NLTEST (SETNLX, TPLBIT)) CALL FAULTP (49) IF (.NOT. (NLTEST (SETNLX, CBIT)))GO TO 13010 SOPC = LDAIMM IF ( STMODE .EQ. DPMODE ) SWFOPN = WF12 STBIAS = NLOPS (CVALUE, SETNLX) SETNLX = NULLX GO TO 13011 13010 CONTINUE IF (.NOT. (.NOT. ZPFLAG))GO TO 13012 SOPC = LDAABS SWF = WF8 13012 CONTINUE 13011 CONTINUE 1 CALL STSET (SETSTX, SETNLX, STMODE, STBIAS, SOPC, SWF, SWFOPN 1) SUBX (SETSTX) = SSUBX SUBXB (SETSTX) = SSUBXB SUBXM (SETSTX) = SSUBXM SUBOP (SETSTX) = SSUBOP WFSOP (SETSTX) = SWFSUB CALL DUMST ('SETX') RETURN 5000 CONTINUE IF (.NOT. (.NOT. STLOC))GO TO 13014 IF (.NOT. (STBIAS .LT. 255 .AND. STBIAS .GE. 0))GO TO 13016 CALL PLOAD (SETNLX, STMODE, 1, TS1) SETNLX = FLS (TS1) SSUBX = NULLX GO TO 6680 13016 CONTINUE CALL PLOAD (SETNLX, STMODE, 2, TS1) SETNLX = NULLX SSUBX = REGS (AREG) GO TO 6210 13014 CONTINUE CALL PLOAD (SETNLX, STMODE, 0, TS1) IF (.NOT. (FLSAVE (TS1) .EQ. 0))GO TO 13018 SOPC = LDAABS SWF = WF8 GO TO 13019 13018 CONTINUE SETNLX = FLS (TS1) 13019 CONTINUE GO TO 1 6000 TS1 = 3 IF (NLTEST (SSUBX, REGBIT)) TS1 = 1 IF (NLTEST (SSUBX, PBIT)) TS1 = 5 IF ( SSUBXM .EQ. DPMODE ) TS1 = TS1 + 1 IF (NLTEST (SSUBX, TPLBIT)) CALL FAULTP (49) IF (STLOC) GO TO 8000 IF (NLTEST (SETNLX, PBIT)) GO TO 7000 GO TO (6100, 6200, 6300, 6400, 6500, 6500),TS1 6100 SOPC = LDAABY SWF = WF8 SWFOPN = WF7 GO TO 1 6200 IF (.NOT. (STAREG .EQ. 0))GO TO 13020 STAREG = SETSTX + STKSIZ ACTLO = XREG ACTHI = AREG 13020 CONTINUE IF (.NOT. ( ZPTST (SETNLX, STBIAS) ))GO TO 13022 SSUBX = SETNLX SSUBXB = STBIAS CALL STSET (SLEFT, REGS (AREG), DPMODE, 0, 0, 0, 0) GO TO 13023 13022 CONTINUE 6210 CALL STSET (SRIGHT, SETNLX, DPMODE, STBIAS, LDAIMM, WF5, WF12) CALL STSET (SLEFT, SSUBX, DPMODE, 0, LDAZP, WF5, WF7) STAREG = SLEFT CALL GEN (PLUS, SLEFT, SRIGHT) SSUBX = NULLX 13023 CONTINUE CTN = 0 GO TO 6600 6300 IF (.NOT. (.NOT. ZPTST (SSUBX, 0) ))GO TO 13024 SSUBOP = LDYABS SWFSUB = WF8 13024 CONTINUE GO TO 6100 6400 IF (.NOT. ( ZPTST (SSUBX, 0) .AND. ZPFLAG))GO TO 13026 TS1 = SSUBX SSUBX = SETNLX SETNLX = TS1 GO TO 6680 13026 CONTINUE CTN = NULLX CTS = SSUBX CTB = 0 CALL STSET (SLEFT, CTS, DPMODE, 0, LDAABS, WF8, WF7) IF (.NOT. (ZPTST (SSUBX, 0)))GO TO 13028 LOPC = LDAZP LWFOP = WF5 13028 CONTINUE IF (.NOT. (ZPFLAG))GO TO 13030 SSUBX = SETNLX SSUBXB = STBIAS CALL REGSRC (3, CTN, ADRFLG, CTS, DPMODE, CTB, SCTN) IF (SCTN .NE. 0) GO TO 6650 CALL GEN (COM + 1, SLEFT, SLEFT) GO TO 6600 13030 CONTINUE IF (.NOT. (ZPTST (SETNLX, 0)))GO TO 13032 SSUBX = SETNLX SSUBXB = 0 CTB = STBIAS GO TO 6420 13032 CONTINUE CTN = SETNLX IF (.NOT. (STBIAS .GE. 0 .AND. STBIAS .LT. 255))GO TO 13034 SSUBX = NULLX SSUBXB = STBIAS GO TO 6420 13034 CONTINUE SSUBX = NULLX SSUBXB = 0 CTB = STBIAS 6420 CALL REGSRC (3, CTN, ADRFLG, CTS, DPMODE, CTB, SCTN) IF (SCTN .NE. 0) GO TO 6650 CALL STSET (SRIGHT, CTN, DPMODE, CTB, LDAIMM, WF5, WF12) CALL GEN (PLUS, SLEFT, SRIGHT) GO TO 6600 6500 CONTINUE CALL PLOAD (SSUBX, SSUBXM, 3, TS1) SSUBX = REGS (AREG) STAREG = SETSTX + STKSIZ CALL DUMST ('PLOD') GO TO 6000 6600 STAREG = SLEFT CALL REGMAN (SAVREG, AREG, SCTN) 6650 SETNLX = REGS (SCTN) CALL REGSRC (6, CTN, ADRFLG, CTS, DPMODE, CTB, SCTN) SSUBOP = LDYIMM STATUS (SCTN) = SETSTX GO TO 6700 6680 SSUBXB = STBIAS SSUBOP = LDYIMM 6700 SOPC = LDAINY SWF = WF5 SWFOPN = WF7 STBIAS = 0 GO TO 1 7000 CONTINUE CALL PARSUB GO TO 6700 8000 IF (.NOT. (NLOPS (NAMAT0, SETNLX) .EQ. 0 .AND. STBIAS .EQ. 0))GO T 1O 13036 SETNLX = SSUBX STMODE = SSUBXM SSUBX = 0 STLOC = .FALSE. GO TO 10 13036 CONTINUE CONTINUE CALL PARLOC GO TO 1 END