SUBROUTINE PCONT 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 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 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 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 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 NAME (9) COMMON /NLNAME/ NAME 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 LISTF, SNLPRT, SUMPRT, SYMFLG INTEGER PRINTF, SKIP, COMPFL (2) INTEGER LOCPRT, USFLGS, NEGFLG, SKNAME (8) INTEGER ORGFLG, CTLUSE, CTLERR, TTL (8) INTEGER DUMFLG INTEGER ICLP01 COMMON /CTLCOM/ LISTF, SNLPRT, SUMPRT, SYMFLG COMMON /CTLCOM/ PRINTF, SKIP, COMPFL COMMON /CTLCOM/ LOCPRT, USFLGS, NEGFLG, SKNAME COMMON /CTLCOM/ ORGFLG, CTLUSE, CTLERR, TTL COMMON /CTLCOM/ DUMFLG COMMON /CTLCOM/ ICLP01 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 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 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 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 TS, HPTR, CHAR, LCITS, LFTS, NEWLCV INTEGER FNLXTS, CONLST (17), CTS, XSEMI, CNAME (16) LOGICAL CZERO (18) INTEGER GCHAR, SNMLST, NLOPS DATA CZERO /.FALSE., .TRUE., .TRUE., .FALSE., .TRUE., .FALSE., . 1TRUE., .FALSE., .TRUE., .TRUE., .FALSE., .FALSE.,.TRUE., .FALSE. 1,.FALSE., .FALSE., .TRUE., .TRUE./ DATA XSEMI /59/ DATA CONLST /'RU','PR','LI','US','EJ','OR','IF','EV','HE','EN', 1'LO','TI','SY','DA','DS','SH','CO'/ DATA CNAME /16*0/ FNLXTS = FNLX LFTS = LISTF LISTF = 0 CALL SET (XSEMI, SOURCE (SRCEND), 3) SRCEND = SRCEND + 3 J = J + 2 CALL FNZS IF (.NOT. (PSYMB .NE. MINUS))GO TO 13000 NEGFLG = -1 GO TO 13001 13000 CONTINUE NEGFLG = 0 CALL FNZS 13001 CONTINUE CALL CTNAME IF (.NOT. (PSYMB .NE. COLON))GO TO 13002 IF (SKIP .LT. 0) GO TO 99 DO 13004 TS = 1, 17 IF (.NOT. (NAME (1) .EQ. CONLST (TS)))GO TO 13006 GO TO (10, 15, 20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70, 75, 80, 1 85, 90),TS 13006 CONTINUE 13004 CONTINUE CTLERR = 71 GO TO 13003 13002 CONTINUE IF (.NOT. (SKIP .LT. 0))GO TO 13008 NK = NK + 1 DO 13010 NI = 1, NK IF (NAME (NI) .NE. SKNAME (NI)) GO TO 99 13010 CONTINUE SKIP = 0 13008 CONTINUE 13003 CONTINUE 99 FNLX = FNLXTS LISTF = LFTS IF (PRINTF .NE. 0) PRINTF = 1 LCTS = LC J = SRCEND RETURN 10 IF (.NOT. (LCI .NE. CODE))GO TO 13012 LCTAB (CODE) = LC - LDLCVO LDLCVO = 0 CALL RLCI (CODE) 13012 CONTINUE IF (NEGFLG .EQ. 0) GO TO 99 ORGFLG = 1 CALL CTNUM ORGFLG = 0 TS = NAMEX (OPX + 1) IF (.NOT. (TS .NE. 0))GO TO 13014 IF (.NOT. (NLOPS (NLXLCI, TS) .EQ. ABSLC))GO TO 13016 LCTAB (ABSLC) = NLOPS (NAMLOC, TS) + BIAS (OPX + 1) LDLCVO = LCTAB (ABSLC) - LC CALL RLCI (ABSLC) GO TO 99 13016 CONTINUE 13014 CONTINUE CTLERR = 11 GO TO 99 15 PRINTF = NEGFLG GO TO 99 20 LFTS = NEGFLG GO TO 99 25 USFLGS = ISHFT (USFLGS, 1) + PRINTF DO 13018 NI = 1, 30 CALL FNZS IF (.NOT. (PSYMB .NE. SEMIC))GO TO 13020 IF (.NOT. (PSYMB .NE. EOCC))GO TO 13022 CALL PCHAR (CNAME, NI, SYMBOL) 13018 CONTINUE GO TO 13023 13022 CONTINUE GO TO 26 13023 CONTINUE 13020 CONTINUE IF (PI .EQ. 7) GO TO 26 CALL OPENF (PI+1, CNAME, TS) IF (TS .NE. 1) GO TO 26 PI = PI + 1 FLINCT (PI) = 0 PSYMB = 0 CALL CTNUM PRINTF = IAND (NUMBER, PRINTF) GO TO 99 26 CTLERR = 74 GO TO 99 30 IF (LCOUNT .GE. 2) CALL NPAGE GO TO 99 35 ORGFLG = 1 CALL CTNUM ORGFLG = 0 TS = NAMEX (OPX+1) IF (.NOT. (TS .NE. 0))GO TO 13024 IF (.NOT. (NLOPS (DFINED, TS) .NE. 0))GO TO 13026 CTS = NLOPS (NLXLCI, TS) NEWLCV = NLOPS (NAMLOC, TS) + BIAS (OPX+1) IF (.NOT. (CTS .EQ. LCI))GO TO 13028 MAXLCV = NEWLCV CALL SETLCI GO TO 99 13028 CONTINUE IF (.NOT. (LOGICF .NE. 0))GO TO 13030 IF (.NOT. (CTS .EQ. ABSLC .OR. CTS .EQ. 1))GO TO 13032 CODE = CTS LCTAB (CODE) = NEWLCV CALL RBOTH (CODE) GO TO 99 13032 CONTINUE 13030 CONTINUE 13026 CONTINUE 13024 CONTINUE CTLERR = 73 GO TO 99 40 OP = -1 CALL CTNUM TS = NUMBER IF (OP .LT. EQUAL .OR. OP .GT. LESSEQ) OP = NEQUAL CTS = OP - EQUAL + 1 IF (TS .LT. 0) CTS = CTS + 6 IF (TS .GT. 0) CTS = CTS + 12 SKIP = 0 IF (.NOT. (NEXTOP .NE. SEMIC))GO TO 13034 IF (CZERO (CTS)) GO TO 99 SKIP = -32767 CALL FNZS CALL CTNAME CALL MOVE (NAME, SKNAME, 8) GO TO 99 13034 CONTINUE IF (CZERO (CTS)) SKIP = -2 GO TO 99 45 CONTINUE CALL CTNUM TS = NUMBER - 1 + LC MAXLCV = (TS/NUMBER)*NUMBER CALL SETLCI GO TO 99 50 CALL SET (XBBL, UHEAD, 15) DO 13036 HPTR = 1, 30 CHAR = GCHAR (RECORD, HPTR + 7) IF (.NOT. (CHAR .NE. EOCC))GO TO 13038 CALL PCHAR (UHEAD, HPTR, CHAR) 13036 CONTINUE 13038 CONTINUE IF (TTL (1) .NE. XBBL) GO TO 99 65 CALL FNZS CALL CTNAME CALL MOVE (NAME, TTL, 8) GO TO 99 55 CONEND = .TRUE. CALL FNZS IF (.NOT. (PSYMB .LT. COMMA))GO TO 13040 CALL RDNAME (-1) NLX = SNMLST (TS) IF (NLOPS (DFINED, NLX) .NE. 0) TNAME = NLX 13040 CONTINUE IF (ENDOK) GO TO 99 CALL FATAL (80) 60 CONTINUE CALL CTNUM LBIAS = NUMBER LOCPRT = NEGFLG GO TO 99 70 SYMFLG = NEGFLG GO TO 99 75 CALL FNZS CALL RDNAME (-1) LCITS = LCI CALL RLCI (DATALC) FNLX = SNMLST (NAME) CALL NDEFN CALL NLSET (NLX, STRBIT) CALL QQDATE (CNAME) DO 13042 TS = 1, 9 CALL BLDBLK (GCHAR (CNAME, TS), WF1) 13042 CONTINUE CALL RLCI (LCITS) GO TO 99 80 DUMFLG = NEGFLG GO TO 99 85 SNLPRT = NEGFLG GO TO 99 90 COMPFL (1) = 0 COMPFL (2) = 0 CONTINUE 13044 CONTINUE CALL FNZS TS = SYMBOL - XA IF (.NOT.(TS .GE. 0))GO TO 13045 IF (.NOT. (TS .GE. 16))GO TO 13046 COMPFL (2) = IOR (COMPFL (2), ISHFT (1, TS-16)) GO TO 13047 13046 CONTINUE COMPFL (1) = IOR (COMPFL (1), ISHFT (1, TS)) 13047 CONTINUE GO TO 13044 13045 CONTINUE GO TO 99 END