SUBROUTINE DIMEN INTEGER TS, IERR INTEGER NBX, NBSTK (20) INTEGER IOTS, IOTS1, INITLC INTEGER MODETS, MTS1 INTEGER OLDMOD, OLDTPL INTEGER REDEF INTEGER FIRST, LAST, COUNT INTEGER NLOPS, CQVAL, SNMLST LOGICAL NLTEST EXTERNAL OLCRU 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 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 LEVELB, NLEVEL, LLEVEL, ILEVEL, CLEVEL INTEGER ICLP04 COMMON /LEVELS/ LEVELB, NLEVEL, LLEVEL, ILEVEL, CLEVEL COMMON /LEVELS/ ICLP04 INTEGER CODE INTEGER NOUNLC INTEGER DATALC INTEGER COMLOC INTEGER FBLOCK INTEGER ZREL INTEGER ABSLC INTEGER CBTAB (15) INTEGER CBX INTEGER LCTAB (15) COMMON /LCFUNC/ CODE COMMON /LCFUNC/ NOUNLC COMMON /LCFUNC/ DATALC COMMON /LCFUNC/ COMLOC COMMON /LCFUNC/ FBLOCK COMMON /LCFUNC/ ZREL COMMON /LCFUNC/ ABSLC COMMON /LCFUNC/ CBTAB COMMON /LCFUNC/ CBX COMMON /LCFUNC/ LCTAB INTEGER LOWWF, LTLNA, LLPOOL, LLNAME, LMOVEP, LBSS INTEGER LEXEQU, LNLEQU COMMON /LCON/ LOWWF, LTLNA, LLPOOL, LLNAME, LMOVEP, LBSS COMMON /LCON/ LEXEQU, LNLEQU 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 NLIST (500) INTEGER NLOC (500) INTEGER NTEXT (1500) INTEGER NTEXTX (500) COMMON /NARAY/ NLIST COMMON /NARAY/ NLOC COMMON /NARAY/ NTEXT COMMON /NARAY/ NTEXTX INTEGER FCHRTS INTEGER SCFLAG INTEGER QMODE INTEGER LBIAS INTEGER SCOUNT INTEGER QINDEX LOGICAL NOTINQ COMMON /SRCEX/ FCHRTS COMMON /SRCEX/ SCFLAG COMMON /SRCEX/ QMODE COMMON /SRCEX/ LBIAS COMMON /SRCEX/ SCOUNT COMMON /SRCEX/ QINDEX COMMON /SRCEX/ NOTINQ 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 XNX, XNXMAX, XNAME (100) COMMON /XNAMC/ XNX, XNXMAX, XNAME FCHRTS = 1 LOGICF = 0 QVALUE = 0 BIAS (OPX) = 0 LEVELB = NLEVEL CALL RBOTH (NOUNLC) ENDOK = .TRUE. 1 NBX = 5 NBSTK (NBX-4) = 0 NBSTK (NBX-3) = STDMD NBSTK (NBX-2) = LODLCI NBSTK (NBX-1) = LCI OLDMOD = STDMD OLDTPL = 0 2 TPFLAG = OLDTPL DEFMOD = OLDMOD FNLX = 0 IOTYPE = 0 CALL NEXP IF (CONEND) RETURN ENDOK = .FALSE. 3 IF (NEXTOP .EQ. EQUAL) GO TO 40 IF (NEXTOP .GT. LBRACE) GO TO 80 GO TO (99, 10, 10, 85, 20, 80, 80, 80, 10, 30),NEXTOP 10 NLX = NAMEX (OPX) IF (.NOT. (NLX .NE. 0))GO TO 13000 CALL SMLCV CALL ADJLOC (BIAS (OPX)) 13000 CONTINUE 15 GO TO (99, 2, 90, 99, 99, 99, 80, 99, 60),NEXTOP 80 CALL FAULTP (4) GO TO 2 85 IF (NAMEX (OPX) .NE. 0) GO TO 80 CALL FAULTP (79) 90 IF (.NOT. (NBX .NE. 5))GO TO 13002 CALL FAULTP (12) GOTO 1 13002 CONTINUE IF (.NOT. (LCI .EQ. NOUNLC))GO TO 13004 CALL RBOTH (CODE) GO TO 1 13004 CONTINUE IOTYPE = 0 RETURN 99 CALL FATAL (6) RETURN 20 IF (.NOT. (NAMEX (OPX) .EQ. NULLX))GO TO 13006 LCTAB (ABSLC) = BIAS (OPX) CALL RBOTH (ABSLC) CALL ADVAN IF (NEXTOP .NE. LBRACE) CALL FAULTP (58) GO TO 35 13006 CONTINUE CALL PEEK IF (.NOT. (PEEKS .EQ. LBK))GO TO 13008 CALL FNZS CALL FNZS NLX = 0 IF (.NOT. (PSYMB .NE. RBK .AND. PSYMB .NE. MULT))GO TO 13010 CALL RDNAME (PERIOD) NLX = SNMLST (DUMMY) 13010 CONTINUE TS = NAMEX (OPX) CALL NLVAL (TS, ISHFT (DEFMOD, MSHIFT), MDMASK) IF (.NOT. (IOTYPE .EQ. ST))GO TO 13012 CALL NLSET (TS, STRBIT) 13012 CONTINUE NLOC (TS) = -1 IF (.NOT. (NLX .NE. 0 .AND. NLX .NE. TS))GO TO 13014 XNAME (XNX) = TS XNAME (XNX+1) = NLX XNX = XNX + 2 IF (.NOT. (XNX .GT. XNXMAX))GO TO 13016 CALL FAULTP (13) XNX = XNXMAX 13016 CONTINUE 13014 CONTINUE CALL LIST (LEXEQU, TS, NLX) IF (.NOT. (PSYMB .EQ. MULT))GO TO 13018 IF (NLX .NE. 0) CALL NLSET (NLX, EXDBIT) CALL FNZS CALL NLSET (NAMEX (OPX), EXDBIT) 13018 CONTINUE CALL FNZS GO TO 2 13008 CONTINUE NAMEX (OPX) = FNLX OSTACK (OPX) = 1026 OPX = OPX + 1 REDEF = PEEKS IF (REDEF .EQ. COLON) CALL FNZS MODETS = DEFMOD DEFMOD = OLDMOD TPFLAG = OLDTPL IOTS = IOTYPE IOTYPE = 0 CALL NEXP OPX = OPX - 1 IF (.NOT. (NEXTOP .EQ. LBRACE))GO TO 13020 DO 13022 I = FBLOCK, CBX IF (.NOT. (CBTAB (I) .EQ. NAMEX (OPX)))GO TO 13024 CALL RBOTH (I) GO TO 35 13024 CONTINUE 13022 CONTINUE IF (.NOT. (CBX .GE. ZREL))GO TO 13026 CALL FAULTP (57) GO TO 35 13026 CONTINUE CALL RBOTH (CBX) NLX = NAMEX (OPX) CBTAB (CBX) = NLX FNLX = NLX CBX = CBX + 1 CALL NDEFN GO TO 35 13020 CONTINUE MTS1 = DEFMOD DEFMOD = MODETS IOTS1 = IOTYPE IOTYPE = IOTS IF (BIAS (OPX) .EQ. 0) BIAS (OPX) = 1 OPTOPX = NAMEX (OPX+1) IF (OPTOPX .EQ. 0) GO TO 80 IF (.NOT. (NLTEST (OPTOPX, CBIT)))GO TO 13028 NLX = NAMEX (OPX) IF (.NOT. ( NLOPS (DFINED, NLX) .NE. 0 .AND. REDEF .NE. COLON))GO 1TO 13030 CALL FAULTP (18) GO TO 2 13030 CONTINUE NLOC (NLX) = OPTOPX CALL NLSET (NLX, ISHFT (DEFMOD, MSHIFT) + CBIT + LCMASK) IF (.NOT. (REDEF .NE. COLON))GO TO 13032 IF (NLTEST (NLX, USEBIT)) CALL NLSET (OPTOPX, USEBIT) 13032 CONTINUE CALL LIST (LNLEQU, NLX, OPTOPX) GO TO 15 13028 CONTINUE NLX = NAMEX (OPX) CALL NDEFN IF (.NOT. (NAMEX (OPX) .NE. NAMEX (OPX+1)))GO TO 13034 DEFMOD = MTS1 IOTYPE = IOTS1 13034 CONTINUE NAMEX (OPX) = NAMEX (OPX+1) SUBX (OPX) = SUBX (OPX+1) BIAS (OPX) = BIAS (OPX+1) GO TO 3 30 IF (.NOT. (ZFLAG))GO TO 13036 CALL RBOTH (ZREL) ZFLAG = .FALSE. GO TO 13037 13036 CONTINUE IF (.NOT. MSEEN) CALL RBOTH (COMLOC) 13037 CONTINUE 35 IF (BIAS (OPX) .NE. 0) CALL FAULTP (5) NBX = NBX + 4 NBSTK (NBX-4) = TPFLAG NBSTK (NBX-3) = DEFMOD NBSTK (NBX-2) = LODLCI NBSTK (NBX-1) = LCI OLDMOD = DEFMOD OLDTPL = TPFLAG GO TO 2 40 NLX = NAMEX (OPX) LABNLX = NLX IF (.NOT. (LABNLX .EQ. 0))GO TO 13038 CALL FAULTP (4) GO TO 2 13038 CONTINUE CALL SMLCV TPFLAG = OLDTPL INITLC = LC 41 QVALUE = 0 DEFMOD = OLDMOD FNLX = 0 CALL NEXP GO TO (99, 42, 42, 85, 43, 50, 80, 80, 42, 43, 80, 45, 1 80, 80, 80, 80, 43), NEXTOP 42 NLX = NAMEX (OPX) IF (.NOT. (NLX .NE. 0))GO TO 13040 IF (.NOT. (.NOT. NLTEST (NLX, CBIT) .AND. QVALUE .EQ. 0 .AND. LOCF 1LG (OPX) .EQ. 0))GO TO 13042 43 IF (INITLC .EQ. LC) CALL FAULTP (30) TS = MAXLCV - LC IF (.NOT. (TS .NE. 0))GO TO 13044 NLX = LABNLX CALL ADJLOC (TS) 13044 CONTINUE GO TO 3 13042 CONTINUE 13040 CONTINUE IF (CQVAL (QVALUE) .GE. 0) CALL NVALUE 44 IF (LC .GT. MAXLCV) MAXLCV = LC IF (NEXTOP .EQ. COMMA) GO TO 41 NAMEX (OPX) = 0 GO TO 43 45 CALL CRUSYM GO TO 44 50 CALL NEXP FIRST = OPX IF (NEXTOP .NE. LBRACE) CALL FAULTP (58) NLX = NAMEX (OPX) IF (.NOT. (NLX .EQ. 0))GO TO 13046 CALL FAULTP (11) COUNT = 0 GO TO 13047 13046 CONTINUE IF (.NOT. (NLTEST (NLX, CBIT)))GO TO 13048 COUNT = NLOPS (CVALUE, NLX) GO TO 13049 13048 CONTINUE CALL FAULTP (11) COUNT = 0 13049 CONTINUE 13047 CONTINUE CONTINUE 13050 CONTINUE CALL NEXP NLX = NAMEX (OPX) IF (.NOT. (NLX .NE. 0))GO TO 13052 IF (.NOT. (CQVAL (QVALUE) .LT. 0 .OR. (CFLAG .EQ. 0 .AND. LOCFLG ( 1OPX) .EQ. 0)))GO TO 13054 CALL FAULTP (11) NAMEX (OPX) = 0 13054 CONTINUE 13052 CONTINUE OPX = OPX + 1 IF (.NOT.(NEXTOP .EQ. COMMA))GO TO 13051 GO TO 13050 13051 CONTINUE IF (NEXTOP .NE. RBRACE) CALL FAULTP (12) LAST = OPX - 1 NEXTOP = COMMA CONTINUE 13056 CONTINUE IF (.NOT.(COUNT .NE. 0))GO TO 13057 DO 13058 OPX = FIRST, LAST CALL NVALUE 13058 CONTINUE COUNT = COUNT - 1 GO TO 13056 13057 CONTINUE OPX = FIRST CONTINUE 13060 CONTINUE CALL PEEK IF (.NOT.(PEEKS .EQ. COMMA))GO TO 13061 CALL FNZS GO TO 13060 13061 CONTINUE GO TO 44 60 MSEEN = .FALSE. NBX = NBX - 4 IF (.NOT. (NBX .LE. 1))GO TO 13062 CALL FAULTP (14) NBX = 5 GO TO 13063 13062 CONTINUE OLDTPL = NBSTK (NBX-4) OLDMOD = NBSTK (NBX-3) LODLCI = NBSTK (NBX-2) CALL BLDBLK (LODLCI, WF14) CALL RLCI (NBSTK (NBX-1)) 13063 CONTINUE GO TO 2 END