SUBROUTINE CODE2 (OPTYPE) 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 ATEST COMMON /ATST/ ATEST 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 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 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 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 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 OSTACK (20) EQUIVALENCE (STK (1, 8), OSTACK (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 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 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 OPTYPE INTEGER NOTEMP, SHFTB, TCVAL, TS INTEGER QQMOD LOGICAL OPEQU, OPNEQ INTEGER NLOPS, ENTNUM LOGICAL NLTEST GO TO ( 1, 1, 1, 1, 1, 1, 700, 100, 500, 1, 300, 600, 1 400, 400, 200, 1), OPTYPE 1 CALL FATAL (6) 100 IF (.NOT. (OP .EQ. MINUS .AND. LOCFLG (NEXTX) .NE. 0 .AND. LOCFLG 1(TOPX) .NE. 0 .AND. SUBX (NEXTX) .EQ. 0 .AND. SUBX (TOPX) .EQ. 0) 1)GO TO 13000 IF (.NOT. (.NOT. NLTEST (OPNXTX, PBIT) .AND. NLOPS (DFINED, OPNXTX 1).NE. 0))GO TO 13002 IF (.NOT. (NLOPS (NLXLCI, OPNXTX) .EQ. NLOPS (NLXLCI, OPTOPX)))GO 1TO 13004 NUMBER = NLOPS (NAMLOC, OPNXTX) + BIAS (NEXTX) - NLOPS (NAMLOC, OP 1TOPX) - BIAS (TOPX) BIAS (NEXTX) = 0 NAMEX (NEXTX) = ENTNUM (DUMMY) LOCFLG (NEXTX) = 0 GO TO 199 13004 CONTINUE 13002 CONTINUE IF (.NOT. (LOGICF .EQ. 0))GO TO 13006 CALL BLDBLK (OPTOPX, WF16) BIAS (NEXTX) = BIAS (NEXTX) - BIAS (TOPX) GO TO 199 13006 CONTINUE 13000 CONTINUE TCVAL=1 GO TO 2000 101 IF (.NOT. (OP .LE. MINUS))GO TO 13008 IF (.NOT. (NEXTOP .EQ. RBK .AND. NLTEST (OPTOPX, CBIT)))GO TO 1301 10 SBIAS = NLOPS (CVALUE, OPTOPX) IF (OP .EQ. MINUS) SBIAS = -SBIAS GO TO 199 13010 CONTINUE 13008 CONTINUE TS = SUBX (TOPX) IF (.NOT. (TS .NE. 0))GO TO 13012 IF (NLTEST (TS, REGBIT) .AND. OP .NE. MINUS) CALL GENER (SWAP) 13012 CONTINUE CALL GENER (SMODEX) IF (.NOT. (OP .EQ. AANDOP))GO TO 13014 IF (.NOT. (MODEX .EQ. 2))GO TO 13016 CALL GENER (TOPSP - RAWMDX + 3) MODEX = 1 13016 CONTINUE OPEQU = NEXTOP .EQ. EQUAL OPNEQ = NEXTOP .EQ. NEQUAL IF (.NOT. (MODEX .EQ. 1 .AND. (OPEQU .OR. OPNEQ)))GO TO 13018 IF (.NOT. (NLTEST (OPTOPX, CBIT) .AND. NLOPS (CVALUE, OPTOPX) .EQ. 1 128))GO TO 13020 OPX = OPX + 1 NOTEMP = NEXTOP CALL ADVAN CALL STUFF OPX = OPX - 1 IF (.NOT. (CFLAG .NE. 0 .AND. NEXTOP .EQ. COLON .AND. NLOPS (CVALU 1E, NAMEX (OPX+1)) .EQ. 0))GO TO 13022 ATEST = .TRUE. IF (OPEQU) NEXTOP = GEQ IF (OPNEQ) NEXTOP = LESS GO TO 199 13022 CONTINUE NEXTOP = NOTEMP 13020 CONTINUE 13018 CONTINUE 13014 CONTINUE IF (.NOT. (OP .NE. MINUS))GO TO 13024 SPTR = TOPX CALL GENER (TSTSTK) IF (GENRET .EQ. 1) CALL GENER (SWAP) 13024 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) 199 RETURN 200 IF (OPNXTX .NE. 0) CALL FAULTP (50) IF (.NOT. (CFLAG .NE. 0))GO TO 13026 NUMBER = NOT (NLOPS (CVALUE, OPTOPX)) NAMEX (NEXTX) = ENTNUM (DUMMY) RETURN 13026 CONTINUE GO TO 610 300 TCVAL=2 GO TO 2000 301 CALL MSTAK (NEXTX, NEXTX+2) CALL SETUP (LDAINX, TOPX) CALL SETUP (LDAINX, NEXTX) CALL GEN (-1, NEXTX, -2) CALL GEN (OP, NEXTX, TOPX) CALL GEN (-1, -2, -2) CALL GENER (OUT) RETURN 400 IF (OPNXTX .NE. 0) CALL FAULTP (50) IF (.NOT. (IAND (OSTACK (TOPX), OCBIT) .NE. 0 .OR. LOCFLG (TOPX) . 1NE. 0))GO TO 13028 CALL FAULTP (23) GO TO 13029 13028 CONTINUE CALL MSTAK (TOPX, NEXTX) CALL SETUP (LDAINX, TOPX) CALL GEN (OP, NEXTX, TOPX) 13029 CONTINUE STOAC = 1 RETURN 500 TCVAL=3 GO TO 2000 501 TS = TOPX + 1 CALL CLRSTK (TS) NAMEX (TS) = REMNLX CALL SETUP (STAINX, TS) CALL SETUP (LDAINX, NEXTX) CALL SETUP (LDAINX, TOPX) MODE (TS) = MODE (NEXTX) NOTEMP = NEXTOP NEXTOP = COMMA CALL GEN (ARROW, NEXTX, TS) ACTHI = 0 ACTLO = 0 BIAS (TS) = 2 MODE (TS) = MODE (TOPX) CALL GEN (ARROW, TOPX, TS) NEXTOP = NOTEMP ACTHI = 0 ACTLO = 0 CALL GEN (OP, NEXTX, TOPX) RETURN 600 IF (.NOT. (CFLAG .NE. 0))GO TO 13030 NUMBER = -NLOPS (CVALUE, OPTOPX) NAMEX (NEXTX) = ENTNUM (DUMMY) RETURN 13030 CONTINUE 610 CALL SETUP (LDAINX, TOPX) MODE (NEXTX) = MODE (TOPX) CALL GEN (OP, TOPX, TOPX) CALL GENER (OUT) RETURN 700 IF (IAND (OSTACK (TOPX), OCBIT) .NE. 0 .OR. LOCFLG (TOPX) .NE. 0) 1CALL FAULTP (23) IF (OPTOPX .EQ. OPNXTX .AND. LOCFLG (NEXTX) .EQ. 0 .AND. MODE (TOP 1X) .EQ. MODE (NEXTX) .AND. SUBX (TOPX) .EQ. SUBX (NEXTX) .AND. BIA 1S(TOPX) .EQ. BIAS (NEXTX) ) GO TO 799 CALL MSTAK (NEXTX, NEXTX + 2) CALL MSTAK (TOPX, TOPX + 2) CALL SETUP (LDAINX, NEXTX) CALL SETUP (STAINX, TOPX) CALL GEN (-1, NEXTX, TOPX) CALL GEN (ARROW, NEXTX, TOPX) CALL GEN (-1, -2, -2) CALL GENER (OUT) 799 STOAC = 1 RETURN 2000 IF (.NOT. (CFLAG .NE. 0 .AND. IAND (OSTACK (OPX-1), OCBIT) .NE. 0) 1)GO TO 13032 QVALUE = 0 L = NLOPS (CVALUE, OPTOPX) K = NLOPS (CVALUE, OPNXTX) SHFTB = 8 IF (K .LT. 0 .OR. K .GT. 255) SHFTB = 16 TS = OP - PLUS + 1 GO TO (2010, 2020, 2030, 2040, 2050, 2060, 2070, 2060, 2080, 2070, 1 2090, 2100, 2110, 2120, 2130, 2140), TS 2010 NUMBER = K + L GO TO 2500 2020 NUMBER = K - L GO TO 2500 2030 NUMBER = K * L GO TO 2500 2040 NUMBER = K / L GO TO 2500 2050 NUMBER = QQMOD (K, L) GO TO 2500 2060 NUMBER = IOR (K, L) GO TO 2500 2070 NUMBER = IAND (K, L) GO TO 2500 2080 NUMBER = IEOR (K, L) GO TO 2500 2090 NUMBER = ISHFT (K, L) IF (SHFTB .EQ. 8) GO TO 2115 GO TO 2500 2100 NUMBER = ISHFT (K, -L) GO TO 2500 2110 NUMBER = ISHFT (K, L) + ISHFT (K, L-SHFTB) IF (SHFTB .NE. 8) GO TO 2500 2115 NUMBER = IAND (NUMBER, 255) GO TO 2500 2120 NUMBER = ISHFT (K, SHFTB-L) + ISHFT (K, -L) IF (SHFTB .EQ. 8) GO TO 2115 GO TO 2500 2130 NUMBER = ISHFT (K, L) IF (SHFTB .EQ. 8) GO TO 2115 IF (.NOT. (K .LT. 0))GO TO 13034 NUMBER = IOR (NUMBER, ISHFT (1, 15)) GO TO 13035 13034 CONTINUE NUMBER = IAND (NUMBER, 32767) 13035 CONTINUE GO TO 2500 2140 NUMBER = ISHFT (K, -L) IF (SHFTB .EQ. 8) GO TO 2115 IF (K .LT. 0) NUMBER = IOR (NUMBER, ISHFT (-1, 16-L)) 2500 NAMEX (NEXTX) = ENTNUM (DUMMY) RETURN 13032 CONTINUE CFLAG = 0 IF (.NOT. (LOGICF .EQ. 0))GO TO 13036 CALL FAULTP (11) RETURN 13036 CONTINUE GOTO (101,301,501),TCVAL END