FTN4,L
      PROGRAM TXPF0(3,89),91711-16006  REV 1926  790828 
      IMPLICIT INTEGER(A-Z) 
      COMMON/EBASE/EBASE(5,1) 
      COMMON/FBAS1/FBAS1(5,1) 
      COMMON/FBAS2/FBAS2(5,1) 
      COMMON/SIS1 /SIS1 (5,1) 
      COMMON/SIS2 /SIS2 (5,1) 
      COMMON/FFP  /FFP  (5,1) 
      COMMON/FFPE1/FFPE1(5,1) 
      COMMON/FFPE2/FFPE2(5,1) 
      COMMON/FFPF1/FFPF1(5,1) 
      COMMON/FFPF2/FFPF2(5,1) 
      COMMON/DBI  /DBI  (5,1) 
      COMMON/VIS  /VIS  (5,1) 
      COMMON/EMA  /EMA  (5,1) 
C 
      DIMENSION REV(7)
      REAL FIRM(7)
C 
      EQUIVALENCE (REV(1),HFPREV),(REV(2),FFPREV),(REV(3),SISREV),
     +            (REV(4),VISREV),(REV(5),DBIREV),(REV(6),EMAREV),
     +            (REV(7),DISREV) 
C 
      DATA FIRM / 4HHFP ,4HFFP ,4HSIS ,4HVIS ,4HDBI ,4HEMA ,4HDIS / 
C*********************************************************************
C 
C     RETRIEVE OUTPUT LU
C 
      CALL RMPAR(REV) 
      LU = REV(1) 
      IF (LU.LE.0) LU = LOGLU(LU) 
C 
C*********************************************************************
C 
C     FIND OUT IF THE COMPUTER IS AN M OR AN E/F MACHINE
C 
      CALL MORFE(ICODE) 
      IF (ICODE.EQ.1) GOTO 10 
      WRITE (LU,800)
      STOP 10 
C 
C*********************************************************************
C 
C     GET INSTALLED FIRMWARE REVISION CODES 
C 
  10  DBIREV = 0
      CALL HFPVF(HFPREV)
      CALL FFPVF(FFPREV)
      CALL SISVF(SISREV)
      CALL VISVF(VISREV)
      CALL EMAVF(EMAREV)
      CALL DISVF(DISREV)
      IF(HFPREV.GT.1.AND.FFPREV.GT.1)DBIREV=FFPREV
C*********************************************************************
C*********************************************************************
C 
C     CHECK FOR FIRMWARE VERIFICATION ERRORS. (ERROR IF REV(I) < 0) 
C 
      WRITE(LU,803) 
      IERR = 0
      DO 20 I=1,7 
         IF (REV(I).GE.0) GOTO 15 
         WRITE(LU,900) FIRM(I)
         IERR = 1 
  15     IF (REV(I).EQ.0) GOTO 16 
         WRITE(LU,801) FIRM(I),REV(I) 
         GOTO 20
  16     WRITE(LU,802) FIRM(I)
  20  CONTINUE
         WRITE(LU,803)
C 
      IF (IERR.NE.0) STOP 11
C 
C*********************************************************************
C 
C     CHECK FIRMWARE-FIRMWARE COMPATIBILITY 
C 
      IF (HFPREV.LE.1.OR.FFPREV.GT.1) GOTO 30 
      WRITE(LU,803) 
      WRITE(LU,901) FIRM(1),FIRM(2) 
      IERR = 1
C 
  30  IF (SISREV.EQ.0.OR.HFPREV.NE.0) GOTO 40 
      WRITE(LU,803) 
      WRITE(LU,901) FIRM(3),FIRM(1) 
      IERR = 1
C 
  40  IF (VISREV.EQ.0.OR.HFPREV.NE.0) GOTO 50 
      WRITE(LU,803) 
      WRITE(LU,901) FIRM(4),FIRM(1) 
      IERR = 1
C 
  50  IF (IERR.NE.0) STOP 12
C 
C*********************************************************************
C 
C     CHECK E-SERIES BASE SET 
C 
      CALL PRSNT(EBASE,IERR,LU) 
C 
C     IF E-SERIES, TEST FOR ABSENCE OF HFP ENTRY POINTS 
C 
      IF (HFPREV.EQ.0) CALL ABSNT(FBAS2,IERR,LU)
C 
C     IF F-SERIES, TEST FOR PRESENCE OF HFP ENTRY POINTS
C 
      IF (HFPREV.GT.0) CALL PRSNT(FBAS1,IERR,LU)
C 
C*********************************************************************
C*********************************************************************
C 
C     IF NO FFP, TEST FOR ABSENCE OF ALL FFP ENTRY POINTS 
C 
      IF (FFPREV.GT.0) GOTO 60
      CALL ABSNT(FFP,IERR,LU) 
      CALL ABSNT(FFPE1,IERR,LU) 
      CALL ABSNT(FFPE2,IERR,LU) 
      CALL ABSNT(FFPF1,IERR,LU) 
      CALL ABSNT(FFPF2,IERR,LU) 
      GOTO 80 
C 
C     FFP PRESENT, SO TEST COMMON ROUTINES
C 
   60 CALL PRSNT(FFP,IERR,LU) 
C 
C     IF E-SERIES, TEST E-SERIES FFP
C 
      IF (HFPREV.GT.0) GOTO 70
      CALL PRSNT(FFPE1,IERR,LU) 
      CALL PRSNT(FFPE2,IERR,LU) 
      CALL ABSNT(FFPF1,IERR,LU) 
      CALL ABSNT(FFPF2,IERR,LU) 
      GOTO 80 
C 
C     F-SERIES, SO TEST F-SERIES FFP
C 
   70 CALL PRSNT(FFPF1,IERR,LU) 
      CALL ABSNT(FFPE2,IERR,LU) 
C     IF OLD FFP, TEST FOR ABSENCE OF NEW ENTRY POINTS
      IF (FFPREV.EQ.1) CALL ABSNT(FFPF2,IERR,LU)
C     IF NEW FFP, TEST FOR PRESENCE OF NEW ENTRY POINTS 
      IF (FFPREV.GT.1) CALL PRSNT(FFPF2,IERR,LU)
C 
C*********************************************************************
C 
C     IF NO SIS, TEST FOR ABSENCE OF SIS ENTRY POINTS 
C 
   80 IF (SISREV.GT.0) GOTO 90
      CALL ABSNT(SIS1,IERR,LU)
      CALL ABSNT(SIS2,IERR,LU)
      GOTO 100
C 
C     SIS PRESENT, TEST COMMON ROUTINES 
C 
   90 CALL PRSNT(SIS1,IERR,LU)
C 
C     IF OLD SIS, TEST FOR ABSENCE OF NEW ENTRY POINTS
      IF (SISREV.EQ.1) CALL ABSNT(SIS2,IERR,LU) 
C 
C     IF NEW SIS, TEST FOR PRESENCE OF NEW ENTRY POINTS 
C 
      IF (SISREV.GT.1) CALL PRSNT(SIS2,IERR,LU) 
C 
C*********************************************************************
C*********************************************************************
C 
C     IF NO VIS, TEST FOR ABSENCE OF VIS ENTRY POINTS 
C 
  100 IF (VISREV.EQ.0) CALL ABSNT(VIS,IERR,LU)
C 
C     IF VIS PRESENT, TEST FOR PRESENCE OF VIS ENTRY POINTS 
C 
      IF (VISREV.GT.0) CALL PRSNT(VIS,IERR,LU)
C 
C*********************************************************************
C 
C     IF NO DBI, TEST FOR ABSENCE OF DBI ENTRY POINTS 
C 
      IF (DBIREV.EQ.0) CALL ABSNT(DBI,IERR,LU)
C 
C     IF DBI, TEST FOR PRESENCE OF DBI ENTRY POINTS 
C 
      IF (DBIREV.GT.0) CALL PRSNT(DBI,IERR,LU)
C 
C*********************************************************************
C 
C     IF NO EMA, TEST FOR ABSENCE OF EMA ENTRY POINTS 
C 
      IF (EMAREV.EQ.0) CALL ABSNT(EMA,IERR,LU)
C 
C     IF EMA, TEST FOR PRESENCE OF EMA ENTRY POINTS 
C 
      IF (EMAREV.GT.0) CALL PRSNT(EMA,IERR,LU)
C 
C*********************************************************************
C 
C     PRINT COMPLETION MESSAGE
C 
      IF (IERR.NE.0) STOP 77
      WRITE(LU,902) 
C 
C*********************************************************************
C 
C     MESSAGE FORMATS 
C 
 800  FORMAT("  TXPF0 - PROGRAM CAN ONLY RUN IN AN E OR F MACHINE") 
 801  FORMAT("  TXPF0 - MODULE ",A4," WITH REV NUMBER ",I6, 
     +" INSTALLED") 
 802  FORMAT("  TXPF0 - MODULE ",A4," NOT INSTALLED") 
 803  FORMAT(" ") 
 900  FORMAT("  TXPF0 - VERIFICATION FAILURE IN FIRMWARE",
     +       " MODULE ",A4) 
 901  FORMAT("  TXPF0 - ERROR. MODULE ",A4,"INCOMPATIBLE WITH", 
     +       " MODULE ",A4) 
 902  FORMAT("  TXPF0 - FIRMWARE VERIFICATION SUCCESSFUL")
C 
C 
C*********************************************************************
      END 
C*********************************************************************
C 
C 
      SUBROUTINE PRSNT(TABLE,IERR,LU),91711-16006 REV 1926  790606
      INTEGER TABLE(5,1)
C 
C 
      INSTR = 1 
C 
   10 IF (TABLE(4,INSTR).EQ.TABLE(5,INSTR)) GOTO 40 
C 
      IF (TABLE(4,INSTR).EQ.0) GOTO 20
      JSB = (TABLE(4,INSTR).AND.074000B) - 014000B
      IF (JSB.NE.0) GOTO 30 
C 
   20 WRITE (LU,900)  (TABLE(I,INSTR),I=1,3)
      IERR = 1
      GOTO 40 
C 
   30 WRITE (LU,901)  (TABLE(I,INSTR),I=1,5)
      IERR = 1
C 
   40 INSTR = INSTR + 1 
      IF (TABLE(1,INSTR).NE.0) GOTO 10
      RETURN
C 
C 
  900 FORMAT ("  TXPF0 - WARNING - ENTRY POINT ",A2,A2,A2,
     +        " INSTALLED BUT NOT DECLARED")
C 
  901 FORMAT ("  TXPF0 -  ERROR  - ENTRY POINT ",A2,A2,A2,
     +        " DECLARED AS ",O6,", SHOULD BE ",O6) 
C 
C*********************************************************************
      END 
C*********************************************************************
C 
C 
      SUBROUTINE ABSNT(TABLE,IERR,LU),91711-16006 REV 1926  790606
      INTEGER TABLE(5,1)
C 
C 
      INSTR = 1 
C 
   10 IF ((TABLE(4,INSTR).AND.074000B).EQ.014000B) GOTO 20
      IF (TABLE(4,INSTR).EQ.0) GOTO 20
C 
      WRITE (LU,900)  (TABLE(I,INSTR),I=1,4)
      IERR = 1
C 
   20 INSTR = INSTR + 1 
      IF (TABLE(1,INSTR).NE.0) GOTO 10
      RETURN
C 
C 
  900 FORMAT ("  TXPF0 - ERROR - ENTRY POINT ",A2,A2,A2,
     +        " DECLARED (",O6,") BUT NOT INSTALLED") 
C 
C*********************************************************************
      END 
                                                        