SUBROUTINE CGEN LOGICAL ATEST COMMON /ATST/ ATEST 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 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 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 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 OPCODE (20) EQUIVALENCE (STK (1, 9), OPCODE (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 OP, LEFT, RIGHT, LSTKX, RSTKX INTEGER TS, LOAD, BASE INTEGER THIS, OTHER, SIDE, HI, LOW INTEGER INTBR, ROW, COL, INREG, OUTREG INTEGER BCC, BNE INTEGER CLC, JMP, LDAABS, LDAI, LDAZP INTEGER SBCI, SEC, STAZP, TAX, TXA LOGICAL COMZER, EZSTA, MORE COMMON /GCOM/ OP, LEFT, RIGHT, LSTKX, RSTKX COMMON /GCOM/ TS, LOAD, BASE COMMON /GCOM/ THIS, OTHER, SIDE, HI, LOW COMMON /GCOM/ INTBR, ROW, COL, INREG, OUTREG COMMON /GCOM/ BCC, BNE COMMON /GCOM/ CLC, JMP, LDAABS, LDAI, LDAZP COMMON /GCOM/ SBCI, SEC, STAZP, TAX, TXA COMMON /GCOM/ COMZER, EZSTA, MORE INTEGER NLOPS INTEGER STEP4 (6), STEP5 (48), STEP10 (12) INTEGER S4SAVE DATA STEP4 / 1, 1, 0, 1, 1, -1/ DATA STEP5 / 240, -1, 208, -1, 208, -1, 176, -1, 144, -1, 240, 1 -1, 208, 0, 208, -1, 0, 0, 0, 0, 0, 0, 0, 0, 240, -1, 208, - 11, 208, -1, -1, 0, -1, 0, 240, -1, 0, 0, 0, 0, 48, 0, 16, -1, 1 48, -1, 48, -1/ DATA STEP10 / 240, 208, 208, 16, 48, 240, 240, 208, 208, 0, 10, 240/ BASE = OP - EQUAL + 1 COMZER = .FALSE. IF (NAMEX (RIGHT) .EQ. NULLX .AND. BIAS (RIGHT) .EQ. 0 .AND. OPCOD 1E(RIGHT) .EQ. LDAI) COMZER = .TRUE. IF (.NOT. (MODE (LEFT) .EQ. DPMODE))GO TO 13000 IF (.NOT. (OP .LE. NEQUAL))GO TO 13002 IF (.NOT. (STAREG .EQ. LEFT .AND. ACTHI .EQ. AREG))GO TO 13004 THIS = HI OTHER = LOW 13004 CONTINUE GO TO 13003 13002 CONTINUE IF (.NOT. (COMZER))GO TO 13006 IF (STAREG .EQ. LEFT .AND. ACTLO .EQ. AREG) CALL GENMOV THIS = HI OTHER = LOW GO TO 13007 13006 CONTINUE IF (.NOT. (STAREG .EQ. LEFT .AND. ACTHI .EQ. AREG))GO TO 13008 THIS = HI OTHER = LOW CALL GENMOV 13008 CONTINUE 13007 CONTINUE 13003 CONTINUE 13000 CONTINUE IF (.NOT. (STAREG .NE. LEFT))GO TO 13010 CALL REGSRC (4, NAMEX (LEFT), MODE (LEFT), SUBX (LEFT), SUBXM (LE 1FT), BIAS (LEFT), TS) IF (.NOT. COMZER .OR. TS .EQ. 0) CALL GENLA 13010 CONTINUE IF (OP .GE. GTR .AND. .NOT. COMZER) CALL BLDBLK (SEC, WF4) IF (.NOT. (.NOT. COMZER))GO TO 13012 SIDE = RIGHT CALL GENDO IF (OP .GE. GTR) CALL REGMAN (CLRACV, AREG, 0) 13012 CONTINUE S4SAVE = 0 IF (.NOT. (.NOT. COMZER .AND. STEP4 (BASE) .LE. 0))GO TO 13014 IF (.NOT. (MODE (LEFT) .EQ. SPMODE))GO TO 13016 CALL GENJMP (STEP4 (BASE), BCC, WF5) GO TO 13017 13016 CONTINUE CALL REGMAN (CTFREE, S4SAVE, 1) S4SAVE = REGS (S4SAVE) CALL BLDOP (133, WF5, 0, S4SAVE, WF7) 13017 CONTINUE 13014 CONTINUE TS = 2*BASE - 1 IF (MODE (LEFT) .EQ. DPMODE) TS = TS + 12 IF (COMZER) TS = TS + 24 IF (.NOT. (STEP5 (TS) .NE. 0))GO TO 13018 IF (.NOT. (STEP5 (TS) .LT. 0))GO TO 13020 IF (.NOT. (ATEST))GO TO 13022 ATEST = .FALSE. GO TO 13023 13022 CONTINUE IF (OP .EQ. GEQ) ILB = 1 CALL FAULTP (39) 13023 CONTINUE TS = TS + 12 13020 CONTINUE CALL GENJMP (STEP5 (TS+1), STEP5 (TS), WF5) 13018 CONTINUE IF (.NOT. (MODE (LEFT) .EQ. DPMODE))GO TO 13024 SIDE = LEFT IF (.NOT. (.NOT. COMZER .OR. (OP .NE. GEQ .AND. OP .NE. LESS)))GO 1TO 13026 IF (.NOT. (COMZER))GO TO 13028 TS = ACTREG (OTHER) IF (.NOT. (TS .EQ. XREG))GO TO 13030 CALL REGMAN (CTFREE, TS, 1) CALL BLDOP (134, WF5, OTHER-1, REGS (TS), WF7) 13030 CONTINUE IF (.NOT. (TS .GT. YREG))GO TO 13032 CALL BLDOP ( 5, WF5, OTHER-1, REGS (TS), WF7) GO TO 13033 13032 CONTINUE RIGHT = LEFT BASE = AOROP - EQUAL + 1 CALL GENMOV 13033 CONTINUE GO TO 13029 13028 CONTINUE CALL GENMOV 13029 CONTINUE 13026 CONTINUE IF (.NOT. (.NOT. COMZER))GO TO 13034 SIDE = RIGHT BASE = OP - EQUAL + 1 CALL GENDO IF (STEP4 (BASE) .LE. 0) CALL GENJMP (STEP4 (BASE), 48, WF5) IF (S4SAVE .NE. 0) CALL BLDOP (5, WF5, 0, S4SAVE, WF7) 13034 CONTINUE TS = OP - EQUAL + 1 IF (COMZER) TS = TS + 6 IF (STEP10 (TS) .NE. 0) CALL GENJMP (-1, STEP10 (TS), WF5) 13024 CONTINUE IF (INTBR .NE. 0) CALL DEFTL (INTBR) INTBR = 0 IF (ILB .EQ. 0) CALL GENJMP (1, JMP, WF8) RETURN END