FTN4,L C NAME : DSPMP--MULTIPOINT SYSTEM STATUS DISPLAY PROGRAM C SOURCE: 91730-18003 1805 C RELOC: 91730-16003 1805 C PROGMR: G.W.J. C C **************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * C * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * C * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C **************************************************************** C C PROGRAM DSPMP(,),91730-16003 REV 1805 780117 DIMENSION ILP(8) C C C DSPMP SCANS THE EQT'S TO FIND THE LINE CONTROL EQT FOR EACH LINE. C A MAXIMUM OF EIGHT LINES CAN BE REPORTED ON. AFTER LOCATING THE C LINE CONTROL EQT'S A REPORT IS MADE FOR THE LINE CONTROL EQT AND C THAN A REPORT IS MADE FOR EACH TERMINAL EQT ON THAT LINE. THE C LINKED LIST IS FOLLOWED TO LOCATE EACH OF THE TERMINAL EQT'S. C C GET THE LU ON TO WHICH THE REPORT IS TO BE MADE. CALL RMPAR(ILP) ILU=ILP(1) C IF NO LU WAS SUPPLIED USE LU 1. IF(ILU.EQ.0)ILU=1 C SETUP POINTERS TO THE EQT IFEQ=IGETX(1650B) INEQ=IGETX(1651B) C SETUP AN INDEX INTO A TABLE WHICH WILL HOLD THE EQT ADDRESS OF C EACH LINE CONTROL EQT. 1 I=1 IEQP=IFEQ C START SCANING THE EQT. DO 5 J=1,INEQ C CHECK FOR DRIVER TYPE 07. IP=IEQP+4 IV=IGETX(IP) IV=IAND(IV,37400B)/256 IF(IV.NE.07B)GO TO 5 C IF TYPE 07 THAN CHECK EQT11 TO SEE IF THIS EQT IS IN A LINKED LIST. IP=IP+6 IV=IGETX(IP) IF(IV.EQ.0)GO TO 5 C IF LINED THAN CHECK FOR BIT 15=1 IN EQT16. (LINE EQT?) IP=IP+2 IP=IGETX(IP) IV=IGETX(IP) IF(IV.GE.0)GO TO 5 C IF LINE EQT THAN MAKE AN ENTERY IN LINE TABLE. ILP(I)=IEQP C BUMP TABLE INDEX I=I+1 C BUMP TO THE NEXT EQT 5 IEQP=IEQP+15 C C C IF I=1 WE DID NOT FIND ANY LINES--STOP IF(I.EQ.1)GO TO 90 C PUT OUT A HEADING ON THE LIST DEVICE. WRITE(ILU,100) 100 FORMAT(1X,"LU EQ A DO OR ET BR EC ICW--- L ID PROG.",/ 1,1X,"EDIT MODE FL. WC- G DF BX SK OB AA RP STATE",/) C MAKE REPORTS ON EACH LINE FOUND DO 1000 II=1,I-1 ILEQ=ILP(II) IF(ILEQ.EQ.0)GO TO 1000 C MAKE A REPORT ON THE LINE CONTROL EQT CALL REPT(ILEQ,IFEQ,ILU) C GET THE LINKED LIST POINTER IP=ILEQ+10 10 IP=IGETX(IP) C IF WE ARE BACK TO THE LINE THAN TERMINATE REPORTING THIS LINE IF(IP.EQ.ILEQ)GO TO 1000 IF(IP.EQ.0)GO TO 1000 C MAKE A REPORT ON EACH TERMINAL EQT. CALL REPT(IP,IFEQ,ILU) IP=IP+10 GO TO 10 C GO TO THE NEXT LINE. 1000 CONTINUE GO TO 99 90 WRITE(ILU,101) 101 FORMAT(1X,"MULTIPOINT SYSTEM INACTIVE") 99 CONTINUE END SUBROUTINE REPT(IPP,IFEQ,ILU) DIMENSION IBF(40),INM(3),ISTB(4),ITB1(3),ITB2(3),ITB3(3) DATA ITB1/2HBU,2HFR,2HD / DATA ITB2/2HSY,2HST,2HM / DATA ITB3/2HCL,2HSI,2HO / C CALCULATE EQT NUMBER 1 IEQN=((IPP-IFEQ)/15)+1 C GET EQT5 IXX=IPP+4 IXX=IGETX(IXX) C DETERMINE AVAILABILITY STATUS IAV=0 IF(IAND(IXX,40000B).NE.0)IAV=IAV+1 IF(IAND(IXX,100000B).NE.0)IAV=IAV+2 C IF AV. ST.=0 SET PROGRAM NAME TO "-----". IF#0 GO CHECK "T" FIELD. IF(IAV.NE.0)GO TO 1000 400 DO 500 N=1,3 500 INM(N)=2H-- GO TO 4000 C GET EQT6 AND MASK OUT "T" FIELD. 1000 IXX=IPP+5 IXX=IGETX(IXX) IXX=IAND(IXX,140000B) C IF "T"=0 GO GET PROGRAM NAME AND MOVE IT TO NAME BUFFER. C IF "T"#0 GO CHECK "T" FIELD TYPE. (BUFFERD-CLASS IO-SYSTEM) IF(IXX.NE.0)GO TO 2000 C GET EQT1 IP=IGETX(IPP) C MASK OF BIT 15 IP=IAND(IP,77777B) C IF EQT1 B0-14=0 SET PGOGRAM NAME TO "-----" IF(IP.EQ.0)GO TO 400 C ADJUST TO NAME PORTION OF ID SEG. IP=IP+12 C MOVE THE NAME. DO 1500 N=1,3 INM(N)=IGETX(IP) 1500 IP=IP+1 GO TO 4000 C DETERMINE "T" FIELD TYPE. 2000 ITF=0 IF(IAND(IXX,40000B).NE.0)ITF=ITF+1 IF(IAND(IXX,100000B).NE.0)ITF=ITF+2 C MOVE "T" FIELD TYPE NAME TO PROG. BUFFER GO TO (2100,2200,2300)ITF 2100 DO 2150 N=1,3 2150 INM(N)=ITB1(N) GO TO 4000 2200 DO 2250 N=1,3 2250 INM(N)=ITB2(N) GOTO 4000 2300 DO 2350 N=1,3 2350 INM(N)=ITB3(N) 4000 CONTINUE C GET EQT4 IP=IPP+3 IXX=IGETX(IP) C GET SELECT CODE (CH) AND UNIT NUMBER FROM EQ4 ICH=IAND(IXX,77B) IUN=IAND(IXX,3700B)/64 IP=IP+1 C SCAN LU TABLE FOR THIS EQT NUMBER AND UNIT NUMBER. JJ=IGETX(1652B) JM=IGETX(1653B) DO 5 J=1,JM JX=IGETX(JJ) JEQ=IAND(JX,77B) C EQT NUMBER = THIS EQT? IF(JEQ.NE.IEQN)GO TO 4 C IF = AND THIS EQT IS ACTIVE CHECK THE UNIT NUMBER FOR A MATCH. IF(IAV.EQ.0)GO TO 10 JUN=IAND(JX,77000B)/4096 IF(IAND(JX,100000B).NE.0)JUN=JUN+8 IF(JUN.EQ.IUN)GO TO 10 4 JJ=JJ+1 5 CONTINUE C IF NO LU FOUND SET LU TO 0 ILUN=0 GO TO 15 C IF INACTIVE SET LU TO THE FIRST LU FOUND POINTING TO THIS EQT 10 ILUN=J 15 CONTINUE C GET EQ5 IXX=IGETX(IP) C BUILD STATUS FROM EQ5 IST=IAND(IXX,377B) C PRESET SATATUS FLAGS TO "--" DO 16 I=1,4 16 ISTB(I)=2H-- C CHECK FOUR FLAGS AND SET APROP. IF(IAND(IST,200B).NE.0)ISTB(1)=2HDO IF(IAND(IST,100B).NE.0)ISTB(2)=2HOB IF(IAND(IST,40B).NE.0)ISTB(3)=2HET IF(IAND(IST,20B).NE.0)ISTB(4)=2HBR C SET ERROR CODE IN LOW 4 BITS/ IST=IAND(IST,17B) C GET EQ6 (REQUEST CONTROL WORD) IP=IP+1 ICW=IGETX(IP) C GET EQ9 (IPRAM1) IP=IP+3 IP1=IGETX(IP) C IF EQ9=0 SET TO "--" IF(IP1.EQ.0)IP1=2H-- C PRESET "RP" FLAG TO "RP" IRP=2HRP C GET EQ12 IP=IP+3 IXX=IGETX(IP) C IF EQ12 BIT 15=1 SET "RP" FLAG TO "--" IF(IXX.LT.0)IRP=2H-- C PRESET SEVEN EDIT MODE FLAGS TO "--" IGF=2H-- ILF=2H-- ICF=2H-- IHF=2H-- IXF=2H-- INF=2H-- ISF=2H-- C CHECK EACH FLAG AND SET APROP. IF(IAND(IXX,40000B).NE.0)IGF=2HR- IF(IAND(IXX,20000B).NE.0)ILF=2HL- IF(IAND(IXX,10000B).NE.0)ICF=2HC- IF(IAND(IXX,4000B).NE.0)IHF=2HH- IF(IAND(IXX,2000B).NE.0)IXF=2HX- IF(IAND(IXX,1000B).NE.0)INF=2HN- IF(IAND(IXX,400B).NE.0)ISF=2HS- C GET EQ16 (ID OR ID SEG.) IP=IP+1 IP=IGETX(IP) C SET ID = TO EQ16 ID=IGETX(IP) C IF ID<0-->LINE EQ. SET ID= TO SELECT CODE CONV. TO ASCII. C IF ID = ID FORCE IP1 TO "--" IF(ID.GT.0)IP1=2H-- IF(ID.LT.0)CALL CNVSC(ICH,ID) C GET EQ17 IP=IP+1 IXX=IGETX(IP) C PRESET DMA FLAG TO "--" IDMA=2H-- C IF DMA FLAG SET SET TO "DF" IF(IXX.LT.0)IDMA=2HDF C PRESET "BX" FLAG TO "EX"--ETX IBX=2HEX C IF "BX" FLAG SET SET TO "EB"--ETB IF((IAND(IXX,40000B)).NE.0)IBX=2HEB C PRESET "SK" FLAG TO "--" ISK=2H-- C IF "SK" FLAG SET SET TO "SK" IF((IAND(IXX,20000B)).NE.0)ISK=2HSK C PRESET "OB" FLAG TO "--" IOB=2H-- C IF FLAG SET SET TO "OB" IF((IAND(IXX,10000B)).NE.0)IOB=2HOB C PRESET "AA" FLAG TO "--" IAA=2H-- C IF FLAG SET SET TO "AA" IF((IAND(IXX,4000B)).NE.0)IAA=2HAA C GET LINE NUMBER ILN=IAND(IXX,3400B)/256 C GET STATE ISTE=IAND(IXX,377B) C GET EQ18 (DMA WORD COUNT) IP=IP+1 C MASK OFF HIGH BITS IWC=IAND((IGETX(IP)),7777B) C CHECK INTERRUPT TABLE TO SEE IS IT IS POINTING TO THIS EQT. IP=ICH-6+IGETX(1654B) IP=IGETX(IP) C IF NOT POINTING HERE SET POINTER TO " " IAP=2H C IF POINTING HERE SET POINTER TO "< " IF(IP.EQ.IPP)IAP=2H< C WRITE THE REPORT ON THE LIST DEVICE. WRITE(ILU,100)ILUN,IEQN,IAV,ISTB(1),ISTB(2),ISTB(3),ISTB(4),IST 1,ICW,ILN,ID,INM(1),INM(2),INM(3),IAP WRITE(ILU,101)IGF,ILF,ICF,IHF,IXF,INF,ISF,IWC,IP1,IDMA,IBX,ISK 1,IOB,IAA,IRP,ISTE 100 FORMAT(1X,I2,1X,I2,1X,I1,1X,A2,1X,A2,1X,A2,1X,A2,1X,@2,1X 1,@6,1X,I1,1X,1A2,1X,2A2,1A1,1X,A1) 101 FORMAT(1X,6A2,1A1,1X,I3,1X,A1,1X,A2,1X,A2,1X,A2,1X,A2,1X 1,A2,1X,A2,1X,@3,/) RETURN END END$