SUBROUTINE PNCHO INTEGER AREAID (15), BCARD (41) INTEGER RWORD1, RWORD2, RWORD3, RWORD (3) INTEGER BTYPE INTEGER EXTDX, ERRFLG INTEGER NEWLCI INTEGER OFFSET, OW INTEGER RBITS, RCT INTEGER TWI INTEGER WF COMMON /OBJCOM/ AREAID, BCARD, RWORD COMMON /OBJCOM/ BTYPE COMMON /OBJCOM/ EXTDX COMMON /OBJCOM/ OFFSET, OW COMMON /OBJCOM/ RBITS COMMON /OBJCOM/ TWI COMMON /OBJCOM/ WF EQUIVALENCE (RWORD1, RWORD (1)) EQUIVALENCE (RWORD2, RWORD (2)) EQUIVALENCE (RWORD3, RWORD (3)) INTEGER WOPTR, WO (64), TLI, TL (128) INTEGER BO, SS, SS2, NRFCH COMMON /SCR1/ WOPTR, WO, TLI, TL COMMON /SCR1/ BO, SS, SS2, NRFCH 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 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 LINSTR (512) COMMON /OBJD/ LINSTR 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 NLIST (500) INTEGER NLOC (500) INTEGER NTEXT (1500) INTEGER NTEXTX (500) COMMON /NARAY/ NLIST COMMON /NARAY/ NLOC COMMON /NARAY/ NTEXT COMMON /NARAY/ NTEXTX 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 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 XNX, XNXMAX, XNAME (100) COMMON /XNAMC/ XNX, XNXMAX, XNAME INTEGER TS, LOCTS, LCSTEP INTEGER OWVER (256), BCNAME (8), OBFILE (16), SRFILE (16) INTEGER SNMLST, ENCNAM, REORG, OBJEXT, NLOPS, GDICT, OBJSYM INTEGER GCHAR EXTERNAL REORG, OBJEXT, OBJSYM LOGICAL NLTEST INTEGER SCR1 (6), SCR2 (6) DATA SCR1 /'LO','GO','SZ','01',' ',' '/ DATA SCR2 /'LO','GO','SZ','02',' ',' '/ DATA BCNAME/ 'X.','BL','AN','K.','CO','MM','ON','. '/ DATA OWVER /1, 2, 0, 0, 0, 2, 2, 0, 1, 2, 1, 0, 0, 3, 3, 0,2, 2, 10, 0, 0, 2, 2, 0, 1, 3, 0, 0, 0, 3, 3, 0,3, 2, 0, 0, 2, 2, 2, 0, 1 1,2, 1, 0, 3, 3, 3, 0,2, 2, 0, 0, 0, 2, 2, 0, 1, 3, 0, 0, 0, 3, 3, 10,1, 2, 0, 0, 0, 2, 2, 0, 1, 2, 1, 0, 3, 3, 3, 0,2, 2, 0, 0, 0, 2, 1 2, 0, 1, 3, 0, 0, 0, 3, 3, 0,1, 2, 0, 0, 0, 2, 2, 0, 1, 2, 1, 0, 13, 3, 3, 0,2, 2, 0, 0, 0, 2, 2, 0, 1, 3, 0, 0, 0, 3, 3, 0,0, 2, 0, 1 0, 2, 2, 2, 0, 1, 0, 1, 0, 3, 3, 3, 0,2, 2, 0, 0, 2, 2, 2, 0, 1, 13, 1, 0, 0, 3, 0, 0,2, 2, 2, 0, 2, 2, 2, 0, 1, 2, 1, 0, 3, 3, 3, 0 1,2, 2, 0, 0, 2, 2, 2, 0, 1, 3, 1, 0, 3, 3, 3, 0,2, 2, 0, 0, 2, 2, 12, 0, 1, 2, 1, 0, 3, 3, 3, 0,2, 2, 0, 0, 0, 2, 2, 0, 1, 3, 0, 0, 0 1,3, 3, 0,2, 2, 0, 0, 2, 2, 2, 0, 1, 2, 1, 0, 3, 3, 3, 0,2, 2, 0, 0 1,0, 2, 2, 0, 1, 3, 0, 0, 0, 3, 3, 0/ DATA OBFILE /16*0/ CALL REW (SS, SCR1) CALL REW (SS2, SCR2) CALL RDSEQ (SS2, SRFILE, 30, ERRFLG) CALL CLOSF(PI,SRFILE) CALL RDSEQ (SS2, OBFILE, 30, ERRFLG) CALL OPENN (BO, OBFILE, ERRFLG) BTYPE = 1 RBITS = 0 CALL MOVE (TTL, BCARD (2), 8) TWI = 10 CALL WRC BTYPE = 4 RBITS = 0 CALL SET (XBBL, BCARD (2), 40) DO 13000 K = 1, 30 TS = GCHAR (SRFILE, K) IF (.NOT. (TS .EQ. 0 .OR. TS .EQ. 13))GO TO 13002 GO TO 13001 13002 CONTINUE CALL PCHAR (BCARD, K+2, TS) 13000 CONTINUE 13001 CONTINUE CALL QQDATE (BCARD (18)) CALL QQTIME (BCARD (23)) CALL EST (CHEAD, BCARD, 57, 72) TWI = 42 CALL WRC EXTDX = 1 CALL SETDI (ABSLC, 0) CALL SETDI (NOUNLC, 1) CALL SETDI (DATALC, 2) CALL SETDI (ZREL, 3) CALL SETDI (CODE, 4) IF (.NOT. (LCTAB (COMLOC) .NE. 0))GO TO 13004 CALL MOVE (BCNAME, NAME, 8) CALL PCHAR (NAME, 1, 14) CBTAB (COMLOC) = SNMLST (DUMMY) NLOC (NLX) = 0 13004 CONTINUE CBX = CBX - 1 DO 13006 K = COMLOC, CBX IF (.NOT. (LCTAB (K) .NE. 0))GO TO 13008 BTYPE = 6 RBITS = 1 AREAID (K) = EXTDX BCARD (2) = EXTDX BCARD (3) = LCTAB (K) TWI = 4 N = CBTAB (K) TS = ENCNAM (N) EXTDX = EXTDX + 1 CALL WRC 13008 CONTINUE 13006 CONTINUE CALL NLSCAN (REORG, N) CALL NLSCAN (OBJEXT, N) IF (.NOT. (XNX .GT. 0))GO TO 13010 DO 13012 I = 1, XNX, 2 N = XNAME (I+1) IF (.NOT. (NLTEST (N, EXTBIT)))GO TO 13014 L = XNAME (I) NLOC (L) = NLOC (N) 13014 CONTINUE 13012 CONTINUE 13010 CONTINUE ADDR = 0 LCI = -1 GO TO 300 100 CALL PCHAR (RWORD, 1, OW) 110 IF (.NOT. (NEWLCI .NE. LCI .OR. LOCTS .NE. LC))GO TO 13016 CALL PUSH (BTYPE, TWI, RBITS) BTYPE = 14 RBITS = 0 LCI = NEWLCI BCARD (2) = AREAID (LODLCI) BCARD (3) = LODLCV TWI = 4 CALL WRC CALL POP (BTYPE, TWI, RBITS) 13016 CONTINUE CALL MOVE (RWORD, BCARD (TWI), RCT) TWI = RCT + TWI CALL WRC OFFSET = 0 LC = LC + LCSTEP LOCTS = LC LODLCV = LODLCV + LCSTEP 140 RCT = 1 RBITS = 1 BTYPE = 10 LCSTEP = 1 RWORD1 = 0 CALL NOW GO TO ( 100, 200, 300, 400, 500, 600, 700, 800, 900, 1000, 11100, 1200, 1300, 1400, 1500, 1600, 1700), WF 200 LC = OW + ADDR GO TO 140 300 NRFCH = NRFCH - 1 IF (NRFCH .LT. 0) GO TO 3000 CALL RDSEQ (SS, TL, 256, ERRFLG) WOPTR = 65 GO TO 140 400 IF (OFFSET .NE. 0) CALL OBJFLT (3) IF (OWVER (OW+1) .NE. 1) CALL OBJFLT (2) GO TO 100 500 BTYPE = 12 RCT = 3 LCSTEP = 2 RWORD2 = OW IF (OWVER (OW+1) .NE. 2) CALL OBJFLT (2) CONTINUE 13018 CONTINUE CALL NOW IF (.NOT.(WF .EQ. WF6))GO TO 13019 OFFSET = OFFSET + OW GO TO 13018 13019 CONTINUE IF (.NOT. (IAND (LINSTR (2*RWORD2+1), 768) .EQ. 512))GO TO 13020 IF (.NOT. (WF .EQ. WF9))GO TO 13022 OFFSET = OFFSET + TL (OW) - LC GO TO 13023 13022 CONTINUE IF (.NOT. (WF .EQ. WF7))GO TO 13024 TS = NLOPS (NLXLCI, OW) OFFSET = OFFSET + NLOC (OW) IF (.NOT. (TS .NE. ABSLC))GO TO 13026 IF (.NOT. (TS .EQ. NEWLCI))GO TO 13028 OFFSET = OFFSET - LC GO TO 13029 13028 CONTINUE OFFSET = 200 13029 CONTINUE 13026 CONTINUE GO TO 13025 13024 CONTINUE CALL OBJFLT (4) 13025 CONTINUE 13023 CONTINUE OFFSET = OFFSET - 2 IF (.NOT. (OFFSET .LT. -128 .OR. OFFSET .GT. 127))GO TO 13030 CALL OBJFLT (5) OFFSET = 0 13030 CONTINUE OW = NULLX WF = WF7 13020 CONTINUE IF (.NOT. (WF .NE. WF7 .AND. WF .NE. WF12 .AND. WF .NE. WF13))GO T 1O 13032 CALL OBJFLT (1) GO TO 140 13032 CONTINUE IF (.NOT. (NLOPS (NAMCON, OW) .NE. 0))GO TO 13034 OW = NLOC (OW) 13034 CONTINUE IF (.NOT. (WF .EQ. WF13))GO TO 13036 RBITS = 2 GO TO 13037 13036 CONTINUE RBITS = 3 13037 CONTINUE RWORD1 = GDICT (OW) RWORD3 = OFFSET GO TO 110 600 OFFSET = OFFSET + OW GO TO 140 700 IF (.NOT. (NLOPS (NAMCON, OW) .NE. 0))GO TO 13038 OW = NLOC (OW) 13038 CONTINUE BTYPE = 11 RBITS = 1 LCSTEP = 2 RCT = 2 RWORD1 = GDICT (OW) RWORD2 = OFFSET GO TO 110 800 BTYPE = 12 RBITS = 1 LCSTEP = 3 RCT = 3 RWORD2 = OW IF (OWVER (OW+1) .NE. 3) CALL OBJFLT (2) CONTINUE 13040 CONTINUE CALL NOW IF (.NOT.(WF .EQ. WF6))GO TO 13041 OFFSET = OFFSET + OW GO TO 13040 13041 CONTINUE IF (.NOT. (WF .EQ. WF9))GO TO 13042 IF (.NOT. (TL (OW) .LT. 0))GO TO 13044 OW = -TL (OW) WF = WF7 13044 CONTINUE 13042 CONTINUE IF (.NOT. (WF .EQ. WF9))GO TO 13046 RWORD1 = AREAID (NEWLCI) GO TO 13047 13046 CONTINUE IF (.NOT. (WF .NE. WF7))GO TO 13048 CALL OBJFLT (1) GO TO 140 13048 CONTINUE IF (.NOT. (NLOPS (NAMCON, OW) .NE. 0))GO TO 13050 OW = NLOC (OW) 13050 CONTINUE IF (.NOT. (NLTEST (OW, EXTBIT)))GO TO 13052 RWORD1 = NLOC (OW) OW = NULLX GO TO 13053 13052 CONTINUE TS = NLOPS (NLXLCI, OW) RWORD1 = AREAID (TS) 13053 CONTINUE 13047 CONTINUE IF (.NOT. (WF .EQ. WF7))GO TO 13054 RWORD3 = NLOC (OW) + OFFSET GO TO 13055 13054 CONTINUE RWORD3 = TL (OW) + OFFSET 13055 CONTINUE GO TO 110 900 GO TO 1300 1000 NEWLCI = OW GO TO 140 1100 CONTINUE 1200 CONTINUE 1300 CONTINUE CALL OBJFLT (1) GO TO 140 1400 LODLCI = OW GO TO 140 1500 LODLCV = OW + ADDR GO TO 140 1600 BTYPE = 13 RBITS = 1 LCSTEP = 2 RCT = 3 RWORD2 = GDICT (OW) OFFSET = -OFFSET CONTINUE 13056 CONTINUE CALL NOW IF (.NOT.(WF .EQ. WF6))GO TO 13057 OFFSET = OFFSET + OW GO TO 13056 13057 CONTINUE IF (.NOT. (WF .NE. WF7))GO TO 13058 CALL OBJFLT (1) OW = NULLX 13058 CONTINUE RWORD1 = GDICT (OW) RWORD3 = OFFSET GO TO 110 1700 BTYPE = 15 RBITS = 0 RWORD1 = OW GO TO 110 3000 DO 13060 I = 1, ZREL IF (.NOT. (LCTAB (I) .NE. 0))GO TO 13062 BTYPE = 14 RBITS = 0 BCARD (2) = AREAID (I) BCARD (3) = LCTAB (I) TWI = 4 CALL WRC 13062 CONTINUE 13060 CONTINUE IF (.NOT. (SYMFLG .NE. 0))GO TO 13064 CALL NLSCAN (OBJSYM, N) 13064 CONTINUE IF (.NOT. (TNAME .NE. 0))GO TO 13066 BTYPE = 17 RBITS = 0 I = NLOPS (NLXLCI, TNAME) BCARD (2) = AREAID (I) BCARD (3) = NLOC (TNAME) TWI = 4 CALL WRC 13066 CONTINUE BTYPE = 2 RBITS = 0 TWI = 2 CALL WRC CALL CLOSF (BO, OBFILE) RETURN END