#RCVXMT                                           19-OCT-82  11:52:24 
C***
C       TITLE   RCVXMT
C
C       VERSION 1.1     OCT1182
C
C
C    FACILITY:
C   TEST PROGRAMS FOR THE COMMUNICATIONS DRIVER PACKAGE CDPACK
C
C
C    ABSTRACT:
C   PERFORMS MULTIPLE READ AND WRITES ON THE LINK WITH NO-WAIT
C   I/O.
C   PROGRAM IS IMPLEMENTED IN 4 PARTS
C	INITIALISATION - DEFINES WHICH PTC TO USE FOR XMT AND
C                        RECEIVE, HOW MANY WORDS TO XMT/RCV AND
C                        HOW MANY MESSAGES OF EACH TYPE TO XMT
C       STARTING I/O   - FOR EACH PTC, EITHER XMT OR RECEIVE, IF
C                        I/O IS NO LONGER ACTIVE FOR IT STARTS
C                        A NEW I/O OPERATION
C       CHECKING STATUS- CHECKS THE STATUS OF EACH I/O OPERATION
C                        REPORTS ANY ERRORS
C	RESULT SUMMARY - GIVES THE OVERALL PICTURE OF HOW MANY
C                        MESSAGES TRANSMITTED AND RECEIVED AND
C                        HOW MANY ERRORS
C
C
C    AUTHOR     VICKY WHITE
C               COMPUTING DEPARTMENT,
C               FERMI NATIONAL ACCELERATOR LAB
C
C   CREATION DATE: JUN2282
C
C   MODIFIED BY:
C   VW-OCT1182 - DELAY AFTER ALL OPENS DONE TO SYNCHRONISE WITH PARTNER
C                PUT IN FORM SUITABLE FOR RT TOO, USING PRE INSTEAD OF
C                INCLUDE FILES
C
C***
*RXINCL
	COMMON/CDCM82/ARRAY(350)	!ALLOW PLENTY ROOM FOR MBS
	COMMON/CDCM83/DUM		!FORCE CONTIGUOUS FOR RT11
        DIMENSION RCVBUF(4000),XBUF(4000)
C
C  SET UP PARAMETERS - PTC TO USE, BUFFER SIZES ETC.
C
C
C  ASSIGN CHANNELS TO LINK DEVICE
C
        CALL RXINIT
C
C  OPEN ALL SESSIONS FOR RECEIVE PTCS
C
	DO 10 IR=1,MAXR
        IF(RPTC(IR).EQ.0) GOTO 10
	CALL CDOPEN(RCHAN(IR),RPTC(IR),STAT)
        IF(STAT(1).NE.1) CALL CDERRM(STAT,MERR)
	IF(STAT(1).NE.1) RPTC(IR) = 0
        IF(STAT(1).EQ.1) RBSY(IR) = .FALSE.
10	CONTINUE
C
C  NOW WAIT TO SYNCHRONISE WITH PARTNER IF NECESSARY
C
	CALL DLKEY
C
C  MAIN PART OF CODE - 2 LOOPS ONE FOR INITIATING I/O REQUESTS
C  ONE FOR DEALING WITH COMPLETED I/O
C
15	IF(STOP) GOTO 500
C
C  LOOP OVER ALL RCV PTC - STARTING NEW READ ON ANY IDLE ONES
C
	DO 20 IR=1,MAXR
	IF(RBSY(IR)) GOTO 20
        IF(MODE.NE.RMODE(IR)) CALL CDMODE(RMODE(IR),0,0,0)    ! CHANGE MODE
	MODE=RMODE(IR)
        CALL CDRCV(RCHAN(IR),RPTC(IR),RCVBUF(RINDX(IR)),RWC(IR),STAT)
        IF(STAT(1).EQ.1) GOTO 16
        CALL CDERRM(STAT,MERR)
	ERRTOT=ERRTOT+1
        GOTO 20
16      RMBN(IR) = STAT(2)
	RBSY(IR) = .TRUE.
20	CONTINUE
C
C  LOOP OVER ALL XMT PTCS
C
	DO 30 IX=1,MAXX
	IF(XBSY(IX)) GOTO 30
        IF(MODE.NE.XMODE(IX)) CALL CDMODE(XMODE(IX),0,0,0)
        MODE=XMODE(IR)
	NXMT=NXMT + 1
	TOTXMT(IX) = TOTXMT(IX) + 1
        IF(TOTXMT(IX).LE.XWC(IX)) XBUF(TOTXMT(IX)) = TOTXMT(IX)
	CALL CDXMT(XCHAN(IX),XPTC(IX),XBUF,XWC(IX),STAT)
        IF(STAT(1).EQ.1) GOTO 22
        CALL CDERRM(STAT,MERR)
	TOTXMT(IX) = TOTXMT(IX) - 1
	ERRTOT=ERRTOT+1
        GOTO 30
22      XMBN(IX) = STAT(2)
	XBSY(IX) = .TRUE.
30	CONTINUE
C
C  LOOP OVER ALL RECEIVE PTCS CHECKING FOR COMPLETION
C
	DO 40 IR=1,MAXR
        IF(.NOT.RBSY(IR) .OR. RPTC(IR).EQ.0) GOTO 40
	CALL CDSTAT(RMBN(IR),INF,STAT)
        IF(INF.EQ.2.OR.INF.EQ.0) GOTO 40  ! RECEIVE STILL PENDING
	IF(INF.EQ.4) GOTO 32
	WRITE(5,1000) RMBN(IR),INF,STAT(1),STAT(2)
1000	FORMAT(' ERROR - ILLEGAL STATUS MB=',I2,' INF=',I6,' STAT=',
     &    2(2X,O6))
        GOTO 35
32	NRCV=NRCV+1
	TOTRCV(IR) = TOTRCV(IR) + 1
	IF(STAT(1).EQ.1) GOTO 33
        RERRS(IR) = RERRS(IR) + 1
        WRITE(5,1010) STAT(1)
1010	FORMAT(' RCV ERROR ',I6)
        CALL CDERRM(STAT(1),MERR)
        ERRTOT=ERRTOT+1
	GOTO 35
33      IF(TOTRCV(IR).GT.STAT(2)) GOTO 35
        IF(RCVBUF(RINDX(IR)+TOTRCV(IR)-1).EQ.TOTRCV(IR)) GOTO 35
        WRITE(5,1002) RPTC(IR),NRCV,RCVBUF(RINDX(IR)+NRCV-1)
1002	FORMAT(' ERROR IN DATA RECEIVED, PTC=',I3,' MSG NO ',I6,
     &     'MSG DATA ',I6)
35      RBSY(IR)=.FALSE.
40	CONTINUE
C
C
C  LOOP OVER ALL TRANSMITS CHECKING FOR COMPLETION
C
	DO 50 IX=1,MAXX
        IF(.NOT.XBSY(IX) .OR. XPTC(IX).EQ.0) GOTO 50
        CALL CDSTAT(XMBN(IX),INF,STAT)
        IF(INF.EQ.1) GOTO 50            ! XMT STILL PENDING
        IF(INF.EQ.3) GOTO 45
        WRITE(5,1001) XMBN(IX),INF,STAT(1),STAT(2)
1001    FORMAT(' ERROR - ILLEGAL STATUS MB=',I3,' INF=',I6,' STAT=',
     &    2(2X,O6))
45      XBSY(IX)=.FALSE.
        IF(STAT(1).EQ.1) GOTO 50
        XERRS(IX) = XERRS(IX) + 1
        WRITE(5,1011) STAT(1)
1011	FORMAT(' XMT ERROR ',I6)
	CALL CDERRM(STAT(1),MERR)
        ERRTOT=ERRTOT+1
50      CONTINUE
C
C  CHECK IF TIME TO STOP
C
        IF(NXMT.GE.XMTMAX .OR. NRCV.GE.RCVMAX) STOP = .TRUE.
        IF(ERRTOT.GE.MAXERR) STOP = .TRUE.
	GOTO 15
C
C  GIVE SUMMARY OF RESULTS AND STOP
C
500     CALL RXSUMM
	CALL EXIT
	END
*DLPAK
*PARFIL
#RSXPAK                                           11-OCT-82  16:56:39
*DLPAK
 
*PARFIL
 
*RTINIT
 
#RTPAK                                            11-OCT-82  17:52:09
*DLPAK
	SUBROUTINE DLYENO(STRING,PAR1,PAR2)
	COMMON/ERRCOM/IERR
	INTEGER PAR1,PAR2
	LOGICAL*1 STRING(1)
	CALL DLOUT(' DO YOU WANT TO')
	CALL DLOUT(STRING)
	TYPE 13
13	FORMAT(' YES(NO)',$)
	READ(5,14)TEST
14	FORMAT(A1)
	IF(TEST.EQ.'Y') PAR2=1
	IF(TEST.EQ.'N') PAR2=0
	IF(TEST.NE.'Y'.AND.TEST.NE.'N') PAR2=PAR1
	IERR=1
	RETURN
	END
	SUBROUTINE DLOUT(STRING)
	COMMON/ERRCOM/IERR
	LOGICAL*1 STRING(1)
	TYPE 11,(STRING(I),I=1,80)
11	FORMAT(' ',80A1,$)
	IERR=1
	RETURN
	END
	SUBROUTINE DLDEC(STRING,CPAR,NPAR,MINPAR,MAXPAR)
	COMMON/ERRCOM/IERR
	LOGICAL*1 STRING(1)
	INTEGER IUND
	DATA IUND/-1/
	INTEGER CPAR,NPAR,MINPAR,MAXPAR
	INTEGER NINPAR,NAXPAR
2	CONTINUE
	CALL DLOUT(STRING)
	IF(IADDR(CPAR).NE.-1)	TYPE 13,CPAR
	IF(IADDR(CPAR).EQ.-1) TYPE 13,IUND
13	FORMAT(' CURRENT VALUE=',I8,' NEW VALUE=',$)
	READ(5,14)LENANS,NPAR
14	FORMAT(Q,I8)
	IF(LENANS.LE.0) GOTO 900
	IF(IADDR(MINPAR).EQ.-1.AND.IADDR(MAXPAR).EQ.-1) RETURN
	IF(IADDR(MINPAR).EQ.-1) NINPAR=-32000
	IF(IADDR(MAXPAR).EQ.-1) NAXPAR=-32000
	IF(IADDR(MAXPAR).NE.-1) NAXPAR=MAXPAR
	IF(IADDR(MINPAR).NE.-1) NINPAR=MINPAR
	IF(NPAR.GT.NAXPAR) CALL DLOUT(' MAXIMUM EXCEEDED')
	IF(NPAR.LT.NINPAR) CALL DLOUT(' LESS THAN MINIMUM')
	IF(NPAR.GT.NAXPAR.OR.NPAR.LT.NINPAR) GOTO 2
	IERR=1
	RETURN
900	CONTINUE
	IERR=2
	IF(IADDR(CPAR).NE.-1) NPAR=CPAR
	RETURN
	END
        SUBROUTINE DLTXT(STRING,OLDSTR,NEWSTR,LENSTR)
	COMMON/ERRCOM/IERR
	LOGICAL*1 STRING(1),OLDSTR(1),NEWSTR(1)
	INTEGER LENSTR
	CALL DLOUT(STRING)
	IF(IADDR(OLDSTR).NE.-1) TYPE 12,(OLDSTR(I),I=1,80)
12	FORMAT(' OLD VALUE WAS=',80A1)
	READ(5,13)LENSTR,(NEWSTR(I),I=1,LENSTR)
13	FORMAT(Q,80A1)
	IERR=1
	IF(LENSTR.NE.0) NEWSTR(LENSTR+1)=0
	RETURN
	END
*PARFIL
	SUBROUTINE PARFIL(INFILE)
	LOGICAL*1 FLNAM
	COMMON/FILENM/FLNAM(32)
	COMMON/ERRCOM/IERR
	LOGICAL*1 INFILE(1)
	DO 11	I=1,32
11	FLNAM(I)=0
	DO 12 I=1,32
	FLNAM(I)=INFILE(I)
12	IF(INFILE(I).EQ.0) GOTO 122
122	CONTINUE
	IERR=1
	RETURN
	END
	SUBROUTINE PARRD
	COMMON/ERRCOM/IERR
	INTEGER ARRAY
	LOGICAL*1 FLNAM
	COMMON/FILENM/FLNAM(32)
	COMMON/OPPARS/ARRAY(1)
	COMMON/OPPART/END
	INTEGER END,COMLEN
	OPEN(UNIT=1,NAME=FLNAM,TYPE='OLD')
	COMLEN=IADDR(END)-IADDR(ARRAY(1))
	COMLEN=COMLEN/2
	READ(1,30)(ARRAY(I),I=1,COMLEN)
30	FORMAT(8I8)
	IERR=1
	CLOSE(UNIT=1)
	RETURN
	END
	SUBROUTINE PARWT
	COMMON/ERRCOM/IERR
	INTEGER ARRAY
	LOGICAL*1 FLNAM
	COMMON/FILENM/FLNAM(32)
	COMMON/OPPARS/ARRAY(1)
	COMMON/OPPART/END
	INTEGER END,COMLEN
	OPEN(UNIT=1,TYPE='NEW',NAME=FLNAM)
	COMLEN=IADDR(END)-IADDR(ARRAY(1))
	COMLEN=COMLEN/2
	TYPE 12,COMLEN
12	FORMAT(' COMLEN=',I8)
	WRITE(1,30)(ARRAY(I),I=1,COMLEN)
30	FORMAT(8I8)
	CLOSE(UNIT=1)
	IERR=1
	RETURN
	END
*RTINIT
C
C  INITIALISATION CODE FOR RT11
C
	IF(IQSET(50).NE.0) STOP 'NOT ENOUGH QUEUE ELEMENTS'
	DO 1212 I=1,20
	XCHAN(I)=CHAN
1212	RCHAN(I)=CHAN
#RXINCL                                           11-OCT-82  17:09:06
*RXINCL
C	INCLUDE FILE FOR RCVXMT TEST PROGRAM
C
C       VICKY WHITE, FNAL       JUN2282
C
	IMPLICIT INTEGER(A-Z)
        LOGICAL*1 RBSY,XBSY,STOP
	COMMON/CHANN/CHAN
	COMMON/ERRCOM/IERR
C
C  ARRAYS OF RECEIVER PTCS AND PARAMETERS FOR EACH RECEIVER PTC
C
        COMMON/OPPARS/
     &  RPTC(20),TOTRCV(20),RBSY(20),RWC(20),RDEV(20),RUNT(20),
     &  RCHAN(20),RMBN(20),RINDX(20),RERRS(20),RMODE(20),
     &  XPTC(20),TOTXMT(20),XBSY(20),XWC(20),XDEV(20),XUNT(20),
     &  XCHAN(20),XMBN(20),XNUM(20),XERRS(20),XMODE(20),
     &  XMTMAX,RCVMAX,NXMT,NRCV,MAXR,MAXX,MAXERR,ERRTOT,
     &  STOP                          !STOP ALWAYS AT END - 1 BYTE
C
	DATA RDEV,XDEV/40*'CD'/
	DATA RUNT,XUNT/40* 0  /
        DATA RBSY,XBSY/40*.TRUE./
	DATA RMODE/20*1/
	DATA RCHAN,XCHAN/40*2/
	DATA XWC/20*1000/
	DATA RWC/20*1000/
	DATA RCVLEN,XMTLEN/8000,4000/
	DATA RCVMAX,XMTMAX/1000,1000/
	DATA MAXR,MAXX/20,20/
	DATA MAXERR/5/
C
	DIMENSION STAT(2)
#RXINIT                                           19-OCT-82  11:49:38
C***
C       TITLE   RXINIT
C
C       VERSION 1.1     OCT1182
C
C
C    FACILITY:
C   TEST PROGRAMS FOR THE COMMUNICATIONS DRIVER PACKAGE CDPACK
C
C
C    ABSTRACT:
C   INITIALISATION SUBROUTINE FOR THE PARAMETERS OF THE TASK
C   RCVXMT
C
C
	SUBROUTINE RXINIT
*RXINCL
C
C  EACH RECEIVE PTC WILL BE ALLOCATED A PIECE OF THE BIG RCVBUF
C  RECEIVER BUFFER - STARTING AT THE CURRENT INDEX VALUE
C
C
C  READ IN SAVED SET OF PARAMETERS IF NEEDED
C
	CALL DLYENO(' USE PREDEFINED PARAMETERS ',PARS,PARS)
	IF(PARS.NE.1) GOTO 1
        CALL DLTXT(' FILE NAME ',,INFILE,32)
        CALL PARFIL(INFILE)
	CALL PARRD
	IF(IERR.NE.1) CALL DLOUT(' FILE READ ERROR ',IERR)
1       INDEX = 1
C
        DO 10 I=1,MAXR
        CALL DLDEC(' ENTER RCV PTC [CR=NO MORE]',,RPTC(I),1,256)
	IF(IERR.EQ.2) GOTO 20
	IF(IERR.EQ.3) GOTO 40
        CALL DLDEC(' ENTER CD UNIT NUMBER',0,RUNT(I),0,7)
11      CALL DLDEC(' MAX RCV BUF WC ',RWC(I),RWC(I))
	IF(INDEX+RWC(I) .LE. RCVLEN) GOTO 12
	CALL DLOUT(' NOT ENOUGH RCV BUFFER SPACE')
	GOTO 11
12	RINDX(I)=INDEX
	INDEX=INDEX+RWC(I)
C
C  ADD HERE ANY OTHER PARAMETERS FOR EACH RCV PTC
C
	CALL DLYENO(' Q RECEIVE QIOS',RMODE(I),RMODE(I))
10	CONTINUE
C
C  XMT PTC PARAMETERS
C
20	DO 30 I=1,MAXX
        CALL DLDEC(' ENTER XMT PTC [CR = NO MORE] ',,XPTC(I),1,256)
	IF(IERR.EQ.2) GOTO 40
        IF(IERR.EQ.3) GOTO 40
        CALL DLDEC(' ENTER CD UNIT NUMBER',0,XUNT(I),0,7)
        XBSY(I) = .FALSE.
	CALL DLDEC(' XMT BUF WC ',XWC(I),XWC(I),1,XMTLEN)
30      CONTINUE
40      CALL DLDEC(' MAX NO OF MSGS TO XMT ',XMTMAX,XMTMAX)
	CALL DLDEC(' MAX NO OF MSGS TO RCV ',RCVMAX,RCVMAX)
        CALL DLDEC(' MAX NO OF ERRORS ',MAXERR,MAXERR,1)
	CALL DLYENO(' SAVE CURRENT PARAMETERS ',SAV,SAV)
	IF(SAV.NE.1) GOTO 100
	CALL DLTXT(' FILE NAME ',INFILE,OUTFIL,32)
	CALL PARFIL(OUTFIL)
	CALL PARWT
	IF(IERR.NE.1) CALL DLOUT(' FILE WRITE ERROR ',IERR)
C
C  ASSIGN CHANNELS TO CD DRIVER.
100	CONTINUE
        DO 110 I=1,MAXR
        CALL CDASGN(RCHAN(I),'CD',RUNT(I),STAT)
        IF(STAT(1).NE.1) CALL CDERRM(STAT,MERR)
110	CONTINUE
	DO 120 I=1,XMAX
        CALL CDASGN(XCHAN(I),'CD',XUNT(I),STAT)
	IF(STAT(1).NE.1) CALL CDERRM(STAT,MERR)
120	CONTINUE
*RTINIT
	END
#RXSUMM                                           11-OCT-82  16:56:39
C***
C       TITLE   RXSUMM
C
C       VERSION 1.0     JUN2282
C
C
C    FACILITY:
C   TEST PROGRAMS FOR THE COMMUNICATIONS DRIVER PACKAGE CDPACK
C
C
C    ABSTRACT:
C   SUMMARY SUBROUTINE FOR THE TASK
C   RCVXMT
        SUBROUTINE RXSUMM
*RXINCL
        WRITE(5,2000) NXMT,NRCV
2000    FORMAT(' TOTAL XMTS = ',I6,' TOTAL RCVS = ',I6)
        WRITE(5,2001)
2001	FORMAT(' RPTC      NO.MSGS.      NO. ERRORS')
	DO 10 IR=1,MAXR
	IF(RPTC(IR).EQ.0) GOTO 15
	WRITE(5,2002) RPTC(IR),TOTRCV(IR),RERRS(IR)
2002	FORMAT(I6,5X,I6,8X,I6)
10	CONTINUE
C
15	WRITE(5,2003)
2003	FORMAT(' XPTC      NO.MSGS.      NO. ERRORS')
	DO 20 IX=1,MAXX
        IF(XPTC(IX).EQ.0) GOTO 25
        WRITE(5,2002) XPTC(IX),TOTXMT(IX),XERRS(IX)
20	CONTINUE
C
25	RETURN
	END