FTN4,L
C     NAME  :  EXMP--MULTIPOINT EXERSISER PROGRAM 
C     SOURCE:  91730-18002  1805
C     RELOC:   91730-16002  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 EXMP(,),91730-16002 REV 1805 780117 
      DIMENSION IB(800),IBX(40),IIB(800),IHMXM(2) 
      DATA IHMXM/15510B,15544B/ 
1     CALL RMPAR(IB)
C     DETERMINE LIST LOGICAL UNIT NUMBER.  IF ZERO SET TO LU 1. 
      IWLU=IB(1)
      IF(IWLU.EQ.0)IWLU=1 
      ILU=IB(2) 
C     DETERMINE LU TO BE TESTED.  IF ZERO STOP. 
      IF(ILU.EQ.0)STOP 0
C     DETERMINE THE MAXIMUM NUMBER OF ERRORS TO BE REPORTED.
      NN=IB(3)
C     DETERMINE THE TEST BUFFER SIZE. IF ZERO SET TO 20 LINES.
      INL=IB(4) 
      IF(INL.LE.0.OR.INL.GT.20)INL=20 
      IRP=IB(5) 
      ICRLF=6412B 
      CALL CODE 
C     BUILD TEST LINE BUFFER OF 76 ALPHA NUMERIC CHARACTORS 
C      TERMINATED WITH A CR/LF. TOTAL OF 78 CH. IN TEST LINE. 
      WRITE(IBX,101)ICRLF 
2     II=1
C     BUILD TEST BUFFER BY WRITEING THE LINE NUMBER FOLLOWED BY THE 
C       TEST LINE FOR A TOTAL OF UP TO 20 LINES.
C     01,---TEST CH.---CR/LF02---TEST CH.---CR/LF03.........
      DO 1000 J=1,INL 
      CALL CODE 
      WRITE(IBZ,100)J 
      IB(II)=IBZ
100   FORMAT(I2)
      II=II+1 
101   FORMAT("ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" 
     1"ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890ABCD",A2)
      DO 500 I=1,39 
      IB(II)=IBX(I) 
      II=II+1 
500   CONTINUE
1000  CONTINUE
C     CALCULATE THE SIZE OF THE TRANSFER. 
      ICNT=INL*80/2 
C     CLEAR ERROR DETECTED SW.
1500  IS=0
C     TURN OFF ROUTINE POLLING AND SET TO STRIP "GS". 
      CALL EXEC(3,ILU+2300B,140000B)
C     FORCE THE TERMINAL TO BLOCK MODE. 
      WRITE(ILU,200)
200   FORMAT("&s1D") 
C     TRANSMIT THE TEST BUFFER. 
      CALL EXEC(2,ILU+3000B,IB,ICNT)
C     SEND A "HOME-UP" AND SYMULATED ENTER TO THE TERMINAL. 
      CALL EXEC(2,ILU,IHMXM,2)
C     RECEVE THE TEXT FROM THE TERMINAL 
      CALL EXEC(1,ILU,IIB,800)
C     COMPARE TEXT TRANSMITED WITH TEXT RECEVED A WORD AT A TIME. 
      DO 5000 I=1,ICNT
      IF(IB(I).EQ.IIB(I))GO TO 5000 
C     IF A WORD DOES NOT COMPARE REPORT UP TO NN ERRORS ANS SET "IS". 
      IS=IS+1 
      IF(NN.EQ.0)GO TO 5000 
      WRITE(IWLU,102)I,IB(I),IB(I),IIB(I),IIB(I)
102   FORMAT(1X,"WORD ",I3," SHOULD BE ",A2,1H[,@6,1H]," AND IS ",A2
     1,1H[,@6,1H])
      NN=NN-1 
5000  CONTINUE
C     CLEAR EDIT MODE SWITCH AND REENABLE ROUTINE POLLING.
6000  CALL EXEC(3,ILU+2300B,0)
C     IN CASE "NN" WAS ZERO REPORT "NO ERRORS" IF "IS"=0 OR "ERRORS" IF 
C      "IS"#0.
C     DONE
      IF(IS.NE.0)GO TO 90 
      WRITE(IWLU,103) 
103   FORMAT(2X,"NO ERRORS")
      GO TO 98
90    WRITE(IWLU,104)IS 
104   FORMAT(1X,I3,1X,"ERRORS") 
98    CONTINUE
      IF(IRP.EQ.0)GO TO 99
      CALL EXEC(12,0,2,0,-IRP)
      GO TO 1500
99    CONTINUE
      END 
      END$
                    