C TITLE CDTEST C C VERSION 1.1- MAY2782 C C*** C C FACILITY: TEST PROGRAM FOR THE COMMUNICATIONS DRIVERS C FOR RSX AND RT11. THIS PROGRAM RUNS UNDER RSX C C ABSTRACT: THIS TASK TRANSMITS AND RECEIVES SIGNALS AND MESSAGES C TRANSMITTER. IT CAN OPERATE IN EITHER SLAVE MODE C (MIRROR) IN WHICH IT ONLY ECHOS WHATEVER MESSAGE IT C ECEIVES; OR IT CAN OPERATE AS THE INITIATOR OF THE C TEST IN WHICH IT FILLS A BUFFER AND CHECKS THE C DATA OF THE BUFFER IT RECEIVES BACK. C C AUTHOR Vicky White C Computing Department, C Fermi National Accelerator Lab C (on leave of absence from DD Division, CERN, Geneva, Switzerland) C C CREATION DATE: MAY 27TH 1982 C C MODIFIED BY: C C*** INCLUDE 'SY:CDTEST.INC' REAL T1,DELTA,TMSG,TWRD,MSMSG,MSWRD,SECNDS LOGICAL MASTER,DBG DIMENSION HEAD2(80) DIMENSION STAT(2) EQUIVALENCE(IERR,STAT(1)) DATA LHEAD2/80/ DATA MASTER/.FALSE./ C C INITIALISATION C CALL PARLUN(FILLUN) 1 CALL PARFIL(LASFIL) CALL PARRD !READ IN FILE OF LAST PARAMETERS IF (ERR.EQ.1) GOTO 2 CALL DLOUT(' NO PARAMETER FILE SY:[250,2]CDECHO.LAS ') CALL DLTXT(' FILE TO READ IN [DEFAULT NO FILE]',,LASFIL,FILLEN) IF(ERR.EQ.3) GOTO 9990 IF(ERR.EQ.2) GOTO 2 GOTO 1 2 CALL CDASGN(CDLUN,'CD',0,STAT) IF(STAT(1).NE.1) CALL CDERRM(STAT,ERR) CALL CDMODE(QRCV,0,SLEEP,0) CALL MNDEV(MDEV) !SET MENU TERMINAL TYPE CALL MNLUN(MLUN) CALL MNBUFF(MNBUF,500) CALL FMTBUF(HEAD2,LHEAD2) IF(DBG) DEBUG=1 C C SET UP INITIAL RECEIVE PACKET TYPE CODE C RCVEF=CDLUN+1 !EF TO BE SET WHEN MESSAGE ARRIVES IF(LPTC.GT.0) CALL CDOPEN(CDLUN,LPTC,STAT) IF(STAT(1).NE.1) CALL CDERRM(STAT,ERR) C C CALL FILBUF(0) 10 CALL MNCLR CALL MNERAS CALL FMTBUF(HEAD2,LHEAD2) CALL FMTA('RCV PTC=') CALL FMTI(LPTC,3) CALL FMTA(', XMT PTC=') CALL FMTI(TPTC,3) CALL FMTX(2) CALL FMTI(XWC,6) CALL FMTA(' WORD XMT BUFFER - ') IF(ASLEEP) CALL FMTA(' ASLEEP') IF(.NOT.ASLEEP) CALL FMTA(' AWAKE') CALL MNHEAD(' ',HEAD2) CALL MNOPT(1,'WAIT FOR MESSAGE TO ARRIVE') CALL MNOPT(2,'SEND SIGNAL') CALL MNOPT(3,'TRANSMIT MESSAGE') IF(MESSAG.GT.0) CALL MNOPT(12,'RECEIVE PENDING MESSAGE') IF(MESSAG.EQ.0) CALL MNOPT(12,'DISPLAY LAST MESSAGE RECEIVED') CALL MNONOF(13,'QUEUE RECEIVE I/O REQUEST',QRCV) CALL MNOPT(11,'SET PARAMETERS (PTCS,BUFFERS,WC,ETC.)') CALL MNDEC(14,'SIGNAL CODE TO SEND',SSIG,SSIG) IF(ECHO.NE.1) & CALL MNONOF(15,'SLEEP ON NEXT TRANSMIT/RECEIVE',SLEEP) CALL MNOPT(16,'AWAKEN CD') IF(QRCV.NE.1) & CALL MNONOF(4,'AUTO RECEIVE PENDING MESSAGE',AUTOR) CALL MNONOF(5,'AUTOMATIC WAIT FOR MESSAGE AFTER SEND',AUTOW) CALL MNONOF(6,'AUTOMATIC ECHO OF MESSAGE AFTER RECEIVE',ECHO) IF(ECHO.NE.1) GOTO 3 CALL MNONOF(7,'CHECK DATA ON ECHO',ECOCHK) CALL MNDEC(8,'STOP ECHO AFTER THIS MANY ERRORS ',ERRMAX,ERRMAX) CALL MNDEC(9,'NO. MESSAGES TO ECHO (0=INFINITE)',ECOTOT,ECOTOT) CALL MNDEC(10,'PRINT STATUS AFTER THIS MANY ECHOES(0=NO PRINT)' & ,ECOMES,ECOMES) C 3 CALL MNDISP CALL MNIN(OPT) OPT=OPT+3 D CALL DLOUT(' OPT CHOSEN = ',OPT) D CALL DLKEY C C OPTION NUMBER C 1=BACK,2=TOP,3=ERROR C GOTO (9999,9999,2000,100,200,300,10,10, & 1200,10,10,10,10,600,410,13,10,10,900) OPT C C SET QRCV MODE C 13 CALL CDMODE(QRCV,0,0,0) GOTO 10 C C WAIT FOR MESSAGE TO ARRIVE C 100 CALL CDRCV(CDLUN,RPTC,RCVBUF,MAXLEN,STAT) IF(STAT(1).EQ.1) GOTO 101 CALL CDERRM(STAT,ERR) GOTO 2000 101 CALL CDWAIT(MBN) GOTO 2000 C C SEND SIGNAL C 200 CALL CDSIGW(CDLUN,TPTC,SSIG,STAT) IF(IERR.NE.1) GOTO 9000 GOTO 310 C C TRANSMIT MESSAGE C 300 IF(ECHO.NE.1) GOTO 305 IF(ECOERR.GE.ERRMAX) GOTO 3001 IF(ECOTOT.EQ.0 .OR. NTECHO.LT.ECOTOT) GOTO 301 3001 CALL ECOSTP GOTO 10 301 IF(NTECHO.EQ.0) MASTER=.TRUE. IF(NTECHO.EQ.0) GOTO 304 IF(NECHO.NE.0) GOTO 303 C TIMING IF(MASTER) T1=SECNDS(0.0) 303 IF(STAT(2).GT.0) XWC=TWC IF(SLEEP.EQ.1) CALL CDMODE(QRCV,0,SLEEP,0) CALL CDXMTW(CDLUN,TPTC,RCVBUF,XWC,STAT) IF(IERR.EQ.1) GOTO 310 3031 CALL CDERRM(STAT,ERR) CALL DLOUT(' TRANSMIT ERROR') IF(ECHO.EQ.1) ECOERR=ECOERR+1 GOTO 300 304 T1=SECNDS(0.0) 305 CALL CDMODE(QRCV,0,SLEEP,0) CALL CDXMTW(CDLUN,TPTC,XMTBUF,XWC,STAT) IF(IERR.NE.1.AND.ECHO.NE.1) GOTO 9000 IF(IERR.NE.1 .AND. ECHO.EQ.1) GOTO 3031 !RETRANSMIT IF ERROR IF (SLEEP.EQ.1) ASLEEP=.TRUE. SLEEP=0 CALL CDMODE(QRCV,0,0,0) 310 IF(AUTOW.EQ.1) GOTO 100 GOTO 10 C C C RECEIVE PENDING MESSAGE C 400 MODE = 0 IF(SLEEP.EQ.1) CALL CDMODE(QRCV,0,SLEEP,0) 4001 CALL CDRCVW(CDLUN,RPTC,RCVBUF,MAXLEN,STAT) 4010 IF (IERR.NE.1.AND.ECHO.NE.1) GOTO 9000 IF(IERR.EQ.1) GOTO 4002 CALL CDERRM(STAT,ERR) CALL DLOUT('RECEIVE ERROR') ECOERR=ECOERR+1 IF(ECOERR.LT.ERRMAX) GOTO 100 CALL ECOSTP GOTO 10 4002 IF(SLEEP.EQ.1) ASLEEP=.TRUE. SLEEP=0 CALL CDMODE(QRCV,0,0,0) IF(QRCV.NE.1) MESSAG=MESSAG-1 IF(ECHO.NE.1) GOTO 410 C C ECHO MODE - DONT PRINT MESSAGE RECEIVED C NECHO=NECHO+1 NTECHO=NTECHO+1 IF(ECOCHK.NE.1) GOTO 405 IF(.NOT. MASTER) GOTO 405 C C CHECK DATA RECEIVED = DATA SENT C IF(XWC.EQ.STAT(2)) GOTO 401 CALL DLOUT(' RECEIVE WC /= TRANSMIT WC',STAT(2),XWC) ECOERR=ECOERR+1 401 DO 402 I=1,RWC INDEX=I IF(RCVBUF(I).NE.XMTBUF(I)) GOTO 403 402 CONTINUE GOTO 405 403 CALL DLOUT(' RECEIVED BUFFER NOT SAME AS TRANSMITTED') WRITE(5,5010) INDEX,RCVBUF(INDEX),XMTBUF(INDEX) 5010 FORMAT(1X,'WORD ',I6,' RCV BUF= ',O6,' XMT BUF= ',O6,' (OCTAL') ECOERR=ECOERR+1 405 IF(ECOERR.LT.ERRMAX) GOTO 406 C C TOO MANY ERRORS C CALL ECOSTP GOTO 10 C C 406 IF(ECOMES.EQ.0 .OR.NECHO.LT.ECOMES) GOTO 300 C C GIVE ERROR STATUS EVERY ECOMES ECHOES C C C TIMING IF(MASTER) DELTA=SECNDS(T1) CALL DLOUT(' MESSAGES ECHOED = ',NTECHO) IF(.NOT. MASTER) GOTO 300 TMSG=DELTA/FLOAT(NECHO*2) TWRD=TMSG/FLOAT(XWC) MSMSG=TMSG*1000. MSWRD=TWRD*1000. WRITE(5,5020) MSMSG,XWC,MSWRD 5020 FORMAT(1X,F8.0,' MS PER ',I6, & ' WORD TRANSFER : ',F10.6,' MS/WORD') NECHO=0 GOTO 300 C C NORMAL RECEIVE MESSAGE - NOT IN ECHO MODE C 410 CALL DLERAS CALL DLOUT(' MESSAGE RECEIVED LENGTH (WORDS)',STAT(2)) CALL DLYENO(' DISPLAY RECEIVED MESSAGE',DISP,DISP) IF(DISP.EQ.1) GOTO 460 CALL DLKEY IF(ERR.EQ.3) GOTO 9999 GOTO 10 C C DISPLAY LAST MESSAGE RECEIVED C 450 CALL DLERAS 460 CALL DLDEC(' NUMBER OF WORDS ',ND,ND,1) CALL DLYENO(' IN ASCII',ASCII,ASCII) IF(ASCII.EQ.1) GOTO 470 CALL DLYENO(' IN OCTAL',OCTAL,OCTAL) IF(ASCII.EQ.1) GOTO 480 WRITE(5,5000) (RCVBUF(I),I=1,ND) 5000 FORMAT(5(3X,I6),/) GOTO 490 470 WRITE(5,5001) (RCVBUF(I),I=1,ND) 5001 FORMAT((1X,30A2),/) GOTO 490 480 WRITE(5,5002) (RCVBUF(I),I=1,ND) 5002 FORMAT(5(3X,O6),/) 490 CALL DLKEY IF(ERR.EQ.3) GOTO 9999 GOTO 10 C C CHANGE PARAMETERS - CALL INITIALISATION MENU C 600 CALL SETPAR GOTO 10 C C C AWAKEN CD CRIVER C 900 CALL CDWAKE(CDLUN) IF (IERR.NE.1) GOTO 9000 ASLEEP=.FALSE. GOTO 10 C C ECHO MODE TURNED ON C 1200 NTECHO=0 NECHO=0 ECOERR=0 XMTBUF(1)=XWC GOTO 10 C C C MESSAGE ARRIVED OVER LINK - C 2000 CALL CDSTAT(MBN,INF,STAT) !ASK FOR STATUS OF MESSAGE IF(INF.EQ.6) GOTO 2100 !IF PENDING SIGNAL IF(INF.EQ.4) GOTO 4010 IF(INF.NE.2) GOTO 9001 C C MESSAGE WAITING TO BE RECEIVED C MESSAG=MESSAG+1 IF(AUTOR.EQ.1) GOTO 400 CALL DLERAS CALL DLYENO(' MESSAGE PENDING - RECEIVE IT ',RCVNOW,RCVNOW) IF(RCVNOW.EQ.1) GOTO 400 GOTO 10 C C SIGNAL HAS ARRIVED C 2100 NSIGN=NSIGN+1 CALL DLERAS SIGNAL=RWC.AND."377 CALL DLOUT(' SIGNAL RECEIVED',SIGNAL) CALL DLKEY IF(ERR.EQ.3) GOTO 9999 GOTO 10 C C ERROR ON REQUEST TO CD C 9000 CALL CDERRM(STAT,ERR) CALL DLKEY IF(ERR.EQ.3) GOTO 9999 GOTO 10 C C ERROR ON MESSAGE RECEIVE - EF SET - NO MESSAGE OR SIGNAL C 9001 CALL DLERAS CALL DLOUT(' ERROR NO MESSAGE RECEIVED - TIMEOUT/ERROR',STAT(1)) CALL DLKEY GOTO 10 C C ERROR OR TOP OR BACK C 9999 DO 9901 I=1,SAVLEN SAVBUF(I)=XMTBUF(I) 9901 CONTINUE CALL PARWT !REWRITE LAST PARAMETERS IF(ERR.EQ.1) GOTO 9990 CALL DLOUT('$ERROR WRITING PARAMETER FILE') CALL DLOUT(LASFIL) 9990 CALL EXIT END C C SUBROUTINE FILBUF(IFLAG) C C SUBROUTINE TO FILL THE TRANSMIT BUFFER WITH VALUES C EITHER PUT IN ONE BY ONE C OR ALL SAME PATTERN C OR SEQUENTIAL NUMBERS FROM 1 TO N C INCLUDE 'SY:CDTEST.INC' DATA NFILL/3/ !NUMBER OF FILL OPTIONS IF(IFLAG.EQ.1) GOTO 1 C C INITIALISATION PHASE - FILL BUFFER WITH DEFAULT STUFF C ACCORDING TO LAST FILL OPTION CHOSEN C IF(XWC.LE.0) GOTO 900 IF(FILOPT.LE.0 .OR. FILOPT .GT. NFILL+3) GOTO 900 GOTO (900,900,901,10,20,30,40) FILOPT 1 CALL MNCLR CALL MNOPT(1,'ENTER EACH VALUE') CALL MNOPT(2,'FILL WHOLE BUFFER WITH SAME PATTERN') CALL MNOPT(3,'FILL BUFFER WITH NUMBERS 1 TO N') CALL MNOPT(4,'FILL BUFFER WITH TEXT') CALL MNDISP CALL MNIN(FILOPT) FILOPT=FILOPT+3 C GOTO (900,900,901,10,20,30,40) FILOPT C C ENTER EACH VALUE C 10 IF(IFLAG.EQ.1) GOTO 11 101 IF(XWC.GT.SAVLEN) & CALL DLOUT(' ** WARNING** ONLY 20 WORDS OF XMT BUFFER RESTORED') DO 111 I=1,20 111 XMTBUF(I)=SAVBUF(I) GOTO 900 11 DO 12 I=1,XWC CALL DLDEC(' ENTER VALUE(DECIMAL)',XMTBUF(I),XMTBUF(I)) 12 IF(ERR.EQ.3) GOTO 900 GOTO 900 C C FILL WHOLE BUFFER WITH SAME PATTERN C 20 IF(IFLAG.EQ.0) GOTO 21 CALL DLOCT(' ENTER PATTERN (OCTAL)',PAT,PAT) IF(ERR.EQ.3) GOTO 900 21 DO 22 I=1,XWC 22 XMTBUF(I)=PAT GOTO 900 C C FILL BUFFER WITH SEQUENTIAL NUMBERS C 30 DO 32 I=1,XWC 32 XMTBUF(I)=I GOTO 900 C C FILL BUFFER WITH TEXT C 40 IF(IFLAG.NE.1) GOTO 101 CALL DLTXT(' ENTER TEXT',XMTBUF(1),XMTBUF(1),80) GOTO 900 C C CONTROL Z ON QUESTION OR TOP OR BACK ON MENU C 900 ERR=1 IF(ECHO.NE.1) GOTO 999 XMTBUF(1)=XWC DO 910 I=1,XWC 910 RCVBUF(I)=XMTBUF(I) 999 RETURN C C CAME OUT OF MENU BECAUSE OF MESSAGE ARRIVING C 901 ERR=4 RETURN END SUBROUTINE SETPAR INCLUDE 'SY:CDTEST.INC' DIMENSION STAT(2) C C SETS UP BASIC PARAMETERS FOR THE MENU AND THE C RECEIVES AND TRANSMITS OVER THE LINK C ALSO CALLED ON REQUEST TO CHANGE THESE BASIC PARAMETERS C 10 CALL MNCLR CALL MNERAS CALL MNOPT(1,'CONTINUE') CALL MNDEC(2,'RECEIVE PTC',LPTC,RPTC,1,256) CALL MNDEC(3,'TRANSMIT PTC',TPTC,TPTC,1,256) CALL MNDEC(4,'LENGTH TRANSMIT BUFFER (WORDS)',XWC,XWC,1,XMMLEN) CALL MNOPT(5,'FILL TRANSMIT BUFFER') CALL MNOPT(6,'DISPLAY TRANSMIT BUFFER') CALL MNONOF(7,'DEBUG PRINTOUT',DEBUG) CALL MNDEC(8,'TIMEOUT FOR RECEIVE MESSAGE (SECS)',TIMO,TIMO,1) CALL MNDEC(11,'MENU DEVICE TYPE',MDEV,MDEV,0,8) CALL MNTXT(12,'WRITE CURRENT PARAMETERS TO FILE', & LASFIL,LASFIL,FILLEN) CALL MNTXT(13,'READ CURRENT PARAMETERS FROM FILE', & RDFIL,RDFIL,FILLEN) CALL MNDISP CALL MNIN(OPT) OPT=OPT+3 GOTO (999,100,999,100,200,10,10,500,600,700,10,10,10,10,12,13) & OPT C C SET RECEIVE PTC C 200 CALL CDCLOS(CDLUN,LPTC,STAT) !REMOVE LAST PTC DEFINITION IF(STAT(1).NE.1) CALL CDERRM(STAT,ERR) CALL CDOPEN(CDLUN,RPTC,STAT) IF(STAT(1).NE.1) CALL CDERRM(STAT,ERR) IF(IERR.NE.1) CALL CDERRM(STAT,ERR) LPTC=RPTC CALL DLOUT(' RPTC= ',RPTC) GOTO 10 C C FILL TRANSMIT BUFFER C 500 CALL FILBUF(1) GOTO 10 C C SET TIMEOUT PERIOD ON WAIT FOR NEXT MESSAGE OR SIGNAL C C C DISPLAY TRANSMIT BUFFER C 600 CALL MNERAS CALL DLDEC('NUMBER OF WORDS ',ND,ND,1) CALL DLYENO(' IN ASCII',ASCII,ASCII) IF(ASCII.EQ.1) GOTO 610 CALL DLYENO(' IN OCTAL',OCTAL,OCTAL) IF(OCTAL.EQ.1) GOTO 620 WRITE(5,5000) (XMTBUF(I),I=1,ND) 5000 FORMAT(5(3X,I6),/) GOTO 690 610 WRITE(5,5001) (XMTBUF(I),I=1,ND) 5001 FORMAT((1X,30A2),/) GOTO 690 620 WRITE(5,5002) (XMTBUF(I),I=1,ND) 5002 FORMAT(5(3X,O6),/) 690 CALL DLKEY GOTO 10 C C SET DEBUG MODE ON C 700 DBG=.FALSE. IF(DEBUG.EQ.1) DEBUG=.TRUE. GOTO 10 C C SET MENU DEVICE TYPE C 900 CALL MNDEV(MDEV) GOTO 10 C C WRITE PARAMETERS FILE NAME C 12 CALL PARFIL(LASFIL) CALL PARWT IF(ERR.NE.1) CALL DLOUT(' ERROR WRITING FILE ',IERR) GOTO 10 C C READ PARAMETERS FROM SAVED FILE C 13 CALL PARFIL(RDFIL) CALL PARRD IF(ERR.NE.1) CALL DLOUT(' ERROR READING FILE ',IERR) GOTO 10 100 ERR=1 RETURN 999 ERR=-1 RETURN END SUBROUTINE ECOSTP INCLUDE 'SY:CDTEST.INC' C C STOP ECHO PROCESS - TOTAL MESSAGES EXCEEDED OR C TOO MANY ERRORS TO CONTINUE C CALL DLOUT(' TOTAL ERRORS = ',ECOERR) CALL DLOUT(' TOTAL MESSAGES ECHOED ',NTECHO) CALL DLKEY NTECHO=0 NECHO=0 ECOERR=0 RETURN END