C***
C       TITLE   ECHODB
C
C       Version 1.0     JAN 05 1983
C
C
C    FACILITY:
C
C    TEST PROGRAM USING CDPACK, FOR RT AND RSX COMMUNICATIONS DRIVERS
C    
C
C    ABSTRACT:
C
C    THIS IS A SIMPLE ECHO TEST PROGRAM WHICH GIVES THE TIME TO
C    TRANSFER A BUFFER FROM ONE MACHINE TO THE OTHER, ASSURING THAT
C    THERE IS ALWAYS A BUFFER AVAILABLE TO RECEIVE THE DATA.  THIS
C    AVOIDS HAVING THE UNKNOWN AND EXTRA OVERHEADS INCURRED WHEN
C    ONE MACHINE IS FASTER THAN THE OTHER.  NORMALLY IF A MESSAGE
C    ARRIVES, BEFORE A BUFFER TO RECEIVE IT HAS BEEN ALLOCATED
C    IN BOTH RT-11 AND RSX THERE IS A TIME DELAY AND EXTRA OVERHEAD
C    RT-11 WILL ONLY WAIT ONE CLOCK TICK, WHEREAS RSX WILL QUEUE
C    AN AST TO A TASK AND WAIT ABOUT 2 SECONDS BEFORE ACTUALLY 
C    DECLARING AN ERROR.
C    ON SIDE MUST BE STARTED AS A SLAVE, THE OTHER AS A MASTER
C
C
C    AUTHOR     Vicky White
C               Computing Department,
C               Fermi National Accelerator Lab
C
C   CREATION DATE:
C     JAN 05 1983
C
C   MODIFIED BY:
C    made into double buffered echo  VW  jan-25-83
C
C***
	PROGRAM ECHO
	IMPLICIT INTEGER(A-Z)
	DIMENSION STAT(2)
	DIMENSION BUF(4000),RCVBUF(4000)
	REAL T1,DT,SECNDS
	COMMON/CDCM82/ISPCD(500)
	COMMON/CDCM83/ISKCP
	DATA NLOOP/1000/
	DATA MAXWC,WC/4000,2000/
	DATA LUN/3/
CCC     IF(IQSET(50).NE.0) STOP 'Q SNAFU'
	CALL CDASGN(LUN,'CD',0,STAT)
        IF(STAT(1).NE.1) GOTO 991
	CALL CDOPEN(LUN,1,STAT)
        IF(STAT(1).NE.1) GOTO 992
        CALL DLDEC(' NUMBER OF LOOPS',NLOOP,NLOOP,,)
	N=NLOOP
       CALL DLDEC(' DELAY COUNT',NDELAY,NDELAY,,)
       CALL DLDEC(' DELAY INCREMENT',INC,INC,,)
        CALL DLYENO(' SLAVE SIDE',SLV,SLV)
	IF(SLV.NE.1) GOTO 2
	CALL CDRCV(LUN,1,BUF,MAXWC,STAT)
        IF(STAT(1).NE.1) GOTO TO 993
	TYPE 1999, RCVMBN,NXTMBN,XMTMBN
1999	FORMAT(' RCVMBN,NXT,XMT= ',3I8)
	RCVMBN=STAT(2)
	GOTO 3
C
C  FIRST TIME FOR THE MASTER - I.E. THE ONE WHICH INITIATES THE
C  FIRST TRANSMIT
C
2       CALL DLDEC(' NO OF WORDS TO TRANSMIT',WC,WC,,)
        T1=SECNDS(0.0)
C
C  MAIN LOOP OF PROGRAM.  THIS ISSUES A RECEIVE FIRST TO MAKE
C  SURE THAT THERE IS ALWAYS A RECEIVE BUFFER AVAILABLE WHEN
C  THE OTHER SIDE SENDS ITS MESSAGE. THEN SENDS A BUFFER AND
C  FINALLY WAITS TO RECEIVE IT BACK.
C
	CONTINUE
	TYPE 1999, RCVMBN,NXTMBN,XMTMBN
       RCVMBN=NXTMBN
	TYPE 1999, RCVMBN,NXTMBN,XMTMBN
        CALL CDRCV(LUN,1,RCVBUF,MAXWC,STAT)
        IF(STAT(1).NE.1) GOTO 993
	TYPE 1999, RCVMBN,NXTMBN,XMTMBN
        NXTMBN=STAT(2)
	TYPE 1999, RCVMBN,NXTMBN,XMTMBN
        IF(RCVMBN.EQ.0) RCVMBN=NXTMBN
	TYPE 1999, RCVMBN,NXTMBN,XMTMBN
1	CALL CDXMT(LUN,1,BUF,WC,STAT)
        IF(STAT(1).NE.1) GOTO 994
	XMTMBN=STAT(2)
	TYPE 1999, RCVMBN,NXTMBN,XMTMBN
202	CONTINUE
	TYPE 12,XMTMBN
12	FORMAT(' WAITING ',I8)
	CALL CDSTAT(XMTMBN,INF,STAT)
	IF(INF.NE.3) GOTO 202
	IF(STAT(1).NE.1) GOTO 994
	IF(SLV.EQ.0) N=N-1
        IF(N.LE.0) GOTO 50
3	CONTINUE
C   DELAY LOOP
C
        NDELAY=NDELAY+INC
        DO 500 K=1,NDELAY
500     CONTINUE
        RCVMBN=NXTMBN
        CALL CDRCV(LUN,1,RCVBUF,MAXWC,STAT)
	TYPE 1999, RCVMBN,NXTMBN,XMTMBN
        NXTMBN=STAT(2)
	TYPE 1999, RCVMBN,NXTMBN,XMTMBN
CC      CALL CDWAIT(RCVMBN)
5       CALL CDSTAT(RCVMBN,INF,STAT)
	TYPE 13,RCVMBN
13	FORMAT(' WARTING',I8)
        IF(INF.NE.4) GOTO 5
        IF(STAT(1).NE.1) GOTO 995
        IF(SLV.NE.1) GOTO 1
        IF(N.EQ.NLOOP) T1=SECNDS(0.0)
        WC=STAT(2)
        N=N-1
        IF(N.GT.0) GOTO 1
50      DT=SECNDS(T1)
        T1=DT*1000./FLOAT(2*NLOOP)
        TYPE 1000, NLOOP,DT,T1,WC
1000    FORMAT(I6,' LOOPS IN ',F6.2,' SECS = ',F6.2,' MS /',I6,'WD XFR')
        TYPE *, NDELAY
	CALL EXIT
C
C  ERROR CONDITIONS ON INITIATING OR COMPLETING CD OPERATIONS
C
991	TYPE 1001
	GOTO 999
992	TYPE 1002
	GOTO 999
993	TYPE 1003
	GOTO 999
994	TYPE 1004
	GOTO 999
995	TYPE 1005
	GOTO 999
999	CALL CDERRM(STAT,IERR)
	CALL EXIT
1001	FORMAT(' ERROR ON CDASGN')
1002	FORMAT(' ERROR ON CDOPEN')
1003    FORMAT(' ERROR ON CDRCV')
1004    FORMAT(' ERROR ON CDXMTW')
1005    FORMAT(' ERROR ON RCV')
	END