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$
                                                                                    