SUBROUTINE OCRUSY INTEGER GROUP1 INTEGER IMPLID INTEGER NGROUP INTEGER NIMPLI INTEGER NOTHER INTEGER NRELTI INTEGER OTHERS INTEGER RELTIV INTEGER STAX INTEGER CSOW INTEGER CSWFA INTEGER CSOFF INTEGER CSNLX INTEGER CSWFB COMMON /CRUCH/ GROUP1 (24) COMMON /CRUCH/ IMPLID (75) COMMON /CRUCH/ NGROUP COMMON /CRUCH/ NIMPLI COMMON /CRUCH/ NOTHER COMMON /CRUCH/ NRELTI COMMON /CRUCH/ OTHERS (165) COMMON /CRUCH/ RELTIV (24) COMMON /CRUCH/ STAX COMMON /CRUCH/ CSOW, CSWFA, CSOFF, CSNLX, CSWFB 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 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 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 NLIST (500) INTEGER NLOC (500) INTEGER NTEXT (1500) INTEGER NTEXTX (500) COMMON /NARAY/ NLIST COMMON /NARAY/ NLOC COMMON /NARAY/ NTEXT COMMON /NARAY/ NTEXTX 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 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 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 LBUF (66) INTEGER LCOUNT INTEGER PGECNT INTEGER UHEAD (15) INTEGER CHEAD (8) INTEGER ICLP09 COMMON /PRT/ LBUF COMMON /PRT/ LCOUNT COMMON /PRT/ PGECNT COMMON /PRT/ UHEAD COMMON /PRT/ CHEAD COMMON /PRT/ ICLP09 INTEGER ABSFLG INTEGER AFLG C INTEGER CSDEB INTEGER CSOP (2) INTEGER CSOPX INTEGER G1MODE (16) INTEGER IMMFLG INTEGER INDFLG INTEGER OPTION INTEGER OTHRMO (9) INTEGER TS INTEGER XFLG INTEGER YFLG INTEGER ZPFLG C INTEGER CLOCN INTEGER NLOPS INTEGER OPSRCH LOGICAL NLTEST, ZPTST DATA G1MODE / 21, 0, 16, 0, 2, 0, 32, 0,25, 0, 20, 24, 40, 1 0, 36, 0 / DATA OTHRMO / 2, 16, 20, 24, 32, 36, 40, 33, 64 / CALL FNZS CALL PCHAR (CSOP, 1, SYMBOL) CALL FNZS CALL PCHAR (CSOP, 2, SYMBOL) CALL FNZS CALL PCHAR (CSOP, 3, SYMBOL) CALL FNZS CALL PCHAR (CSOP, 4, BLANK) INDFLG = 0 IMMFLG = 0 XFLG = 0 YFLG = 0 ZPFLG = 0 ABSFLG = 0 AFLG = 0 CSWFA = WF4 CSWFB = 0 CSOFF = 0 CSNLX = 0 IF ( PSYMB .EQ. SEMIC ) GO TO 1000 C CSDEB = 1 IF ( PSYMB .NE. COMMA ) GO TO 2000 CALL PEEK IF (.NOT. ( PEEKS .EQ. ATSIGN ))GO TO 13002 INDFLG = 1 CALL FNZS GO TO 13003 13002 CONTINUE IF (.NOT. ( PEEKS .EQ. GTR ))GO TO 13004 IMMFLG = 2 CALL FNZS GO TO 13005 13004 CONTINUE IF (.NOT. ( PEEKS .EQ. EQUAL ))GO TO 13006 IMMFLG = 128 CALL FNZS GO TO 13007 13006 CONTINUE IF (.NOT. ( PEEKS .EQ. LESS ))GO TO 13008 IMMFLG = 256 CALL FNZS 13008 CONTINUE 13007 CONTINUE 13005 CONTINUE 13003 CONTINUE CALL ADVAN CSNLX = NAMEX (OPX) IF (.NOT. ( CSNLX .EQ. 0 ))GO TO 13010 IF (.NOT. ( NEXTOP .EQ. SEMIC ))GO TO 13012 GO TO 1000 13012 CONTINUE GO TO 500 13010 CONTINUE IF (.NOT. (NLTEST (CSNLX, REGBIT)))GO TO 13014 IF (.NOT. (NLOPS (REGNUM, CSNLX) .EQ. AREG))GO TO 13016 AFLG = 64 CSNLX = NULLX GO TO 600 13016 CONTINUE C CSDEB = 3 GO TO 3000 13014 CONTINUE IF (.NOT. (NLTEST (CSNLX, CBIT)))GO TO 13018 CSOFF = NLOPS (CVALUE, CSNLX) CSNLX = NULLX GO TO 13019 13018 CONTINUE IF ( IMMFLG .EQ. 128 ) GO TO 3000 CSWFB = WF7 IF (.NOT. ( ZPTST (CSNLX, 0)))GO TO 13020 ZPFLG = 16 GO TO 13021 13020 CONTINUE ABSFLG = 32 13021 CONTINUE 13019 CONTINUE 500 IF (.NOT. ( NEXTOP .GE. PLUS ))GO TO 13022 J = J - 1 NAMEX (OPX) = 0 CALL NEXP TS = NAMEX (OPX) IF (.NOT. (TS .EQ. 0))GO TO 13024 CSWFA = -11 RETURN 13024 CONTINUE IF (.NOT. (.NOT. NLTEST (TS, CBIT)))GO TO 13026 CSWFA = -11 RETURN 13026 CONTINUE CSOFF = CSOFF + NLOPS (CVALUE, TS) 13022 CONTINUE IF (.NOT. ( ZPFLG + ABSFLG .EQ. 0 ))GO TO 13028 IF (.NOT. ( CSOFF .GE. 0 .AND. CSOFF .LT. 256 ))GO TO 13030 ZPFLG = 16 GO TO 13031 13030 CONTINUE ABSFLG = 32 13031 CONTINUE 13028 CONTINUE 600 IF ( NEXTOP .EQ. SEMIC ) GO TO 1000 C CSDEB = 4 IF ( NEXTOP .NE. COMMA ) GO TO 3000 CALL ADVAN NLX = NAMEX (OPX) C CSDEB = 5 IF ( NEXTOP .NE. SEMIC ) GO TO 3000 IF ( NLX .EQ. 0 ) GO TO 1000 C CSDEB = 6 IF (.NOT. NLTEST (NLX, REGBIT)) GO TO 3000 TS = NLOPS (REGNUM, NLX) IF (.NOT. ( TS .EQ. XREG ))GO TO 13032 XFLG = 4 GO TO 13033 13032 CONTINUE IF (.NOT. ( TS .EQ. YREG ))GO TO 13034 YFLG = 8 GO TO 13035 13034 CONTINUE C CSDEB = 7 GO TO 3000 13035 CONTINUE 13033 CONTINUE 1000 OPTION = INDFLG+IMMFLG+XFLG+YFLG+ZPFLG+ABSFLG+AFLG CSOPX = OPSRCH (CSOP, IMPLID, NIMPLI, 3) C CSDEB = 8 IF ( CSOPX .GT. 0 ) GO TO 4000 CSOPX = OPSRCH (CSOP, RELTIV, NRELTI, 3) C CSDEB = 9 IF ( CSOPX .GT. 0 ) GO TO 5000 IF ( IMMFLG .NE. 0 ) OPTION=INDFLG+2+XFLG+YFLG+AFLG CSOPX = OPSRCH (CSOP, GROUP1, NGROUP, 3) C CSDEB = 10 IF ( CSOPX .GT. 0 ) GO TO 6000 CSOPX = OPSRCH (CSOP, OTHERS, NOTHER, 11) C CSDEB = 11 IF ( CSOPX .GT. 0 ) GO TO 7000 CSWFA = -27 C CALL EST (CSOP, LBUF, 1, 4) C CALL SGLPRT RETURN 2000 CSWFA = -22 C CALL ESP (CSDEB, LBUF, 1, 6) C CALL ESP (PSYMB, LBUF, 9, 14) C CALL ESP (NEXTOP, LBUF, 17, 22) C CALL SGLPRT RETURN 3000 CSWFA = -75 C CALL ESP (CSDEB, LBUF, 1, 6) C CALL ESP (OPTION, LBUF, 9, 14) C CALL ESP (CSOPX, LBUF, 17, 22) C CALL ESP (NEXTOP, LBUF, 25, 30) C CALL SGLPRT RETURN 4000 IF ( OPTION .NE. 0 ) GO TO 3000 CSOW = IMPLID (CSOPX+2) GO TO 8000 5000 TS = INDFLG + IMMFLG + XFLG + YFLG + AFLG IF ( TS .NE. 0 ) GO TO 3000 CSOW = RELTIV (CSOPX+2) CSWFA = WF5 CSWFB = WF7 GO TO 8000 6000 DO 6010 TS=1,16 IF ( OPTION .EQ. G1MODE (TS) ) GO TO 6020 6010 CONTINUE GO TO 3000 6020 IF (.NOT. ( ABSFLG .NE. 0 ))GO TO 13036 CSWFA = WF8 GO TO 13037 13036 CONTINUE CSWFA = WF5 13037 CONTINUE IF ( TS .EQ. 12 ) TS=13 CSOW = GROUP1 (CSOPX+2) + ISHFT (TS-1, 1) IF ( CSOPX .EQ. STAX .AND. IMMFLG .NE. 0 ) GO TO 3000 GO TO 7500 7000 DO 7010 TS=1,9 IF ( OPTION .EQ. OTHRMO(TS) ) GO TO 7020 7010 CONTINUE IF (.NOT. ( OPTION .EQ. 17 ))GO TO 13038 TS = 8 GO TO 7020 13038 CONTINUE C CSDEB = 12 GO TO 3000 7020 CSOW = OTHERS (CSOPX+1+TS) C CSDEB = 13 IF ( CSOW .LT. 0 ) GO TO 3000 C CSDEB = 14 CSWFA = WF5 IF ( AFLG .NE. 0 ) CSWFA = WF4 IF ( INDFLG .NE. 0 .OR. ABSFLG .NE. 0 ) CSWFA = WF8 7500 IF ( IMMFLG .EQ. 0 ) GOTO 8000 CSWFA = WF5 IF (.NOT. ( IMMFLG .EQ. 2 ))GO TO 13040 CSWFB = 13 GO TO 13041 13040 CONTINUE CSWFB = 12 13041 CONTINUE GO TO 8010 8000 IF ( CSNLX .EQ. 0 ) CSNLX = NULLX 8010 IF ( CSWFB .EQ. 0 ) CSWFA = 4 CRUCNT = CRUCNT + 1 RETURN END