PROGRAM USRAST C C File USRAST.FTN C C Program to test user AST routine in RSX CDPACK. C C To use this program: C 1. Run USRAST C 2. Run RCVLUP with PTC=2 C 3. Run XMTLUP with PTC=1 C The links to RCVLUP and XMTLUP must be on separate C units, e.g., one internal and one external link. C C Whatever message is received is simply re-transmitted; C the xxxLUP programs should behave as usual, except that C USRAST will be a middleman. C C This program uses the following LUNs: C 1 - receive unit C 2 - transmit unit C 5 - messages to terminal C IMPLICIT INTEGER (A-Z) EXTERNAL USRCMP,USRSIG C PARAMETER (BUFSZ=4000, NBUFF=2) C Allocate space for message blocks and channel table COMMON /CDCM82/ CDCM(20 + (NBUFF+1)*8 + 2*3) COMMON /BUFFER/ BUFF(BUFSZ,NBUFF) C Table of buffer numbers indexed by message block number COMMON /MBINDX/ MBI(NBUFF+1) DATA MBI /0,NBUFF*0/ COMMON /USRCMP/ RCVCNT,XMTCNT,CMPERR COMMON /USRSIG/ SIGCNT,MSGCNT,SIGERR COMMON /PARAMS/ RCVPTC,XMTPTC,MAXWC DATA RCVPTC /1/, XMTPTC /2/ DATA MAXWC /BUFSZ/ C DIMENSION STAT(2) DATA RUNIT,XUNIT /2*0/ C CALL DLDEC(' CD UNIT NUMBER TO RECEIVE ON',RUNIT,RUNIT,0,) CALL CDASGN(1,'CD',RUNIT,STAT) IF (STAT(1).NE.1) THEN CALL CDERRM(STAT,IERR) GOTO 90 ENDIF CALL DLDEC(' CD UNIT NUMBER TO TRANSMIT ON',XUNIT,XUNIT,0,) CALL CDASGN(2,'CD',XUNIT,STAT) IF (STAT(1).NE.1) THEN CALL CDERRM(STAT,IERR) GOTO 90 ENDIF CALL CDUSER(USRCMP,USRSIG) CALL CDOPEN(1,RCVPTC,STAT) IF (STAT(1).NE.1) THEN CALL CDERRM(STAT,IERR) GOTO 90 ENDIF OPNMBN = STAT(2) CALL DLYENO(' Q RCV MODE ',QRCV,QRCV) CALL CDMODE(QRCV,0,0,0) C C Post a receive for each buffer C DO 10 I=1,NBUFF CALL CDRCV(1,RCVPTC,BUFF(1,I),MAXWC,STAT) IF (STAT(1).NE.1) THEN CALL CDERRM(STAT,IERR) GOTO 90 ENDIF MBI(STAT(2)) = I 10 CONTINUE C C At this point, the program is driven entirely by the AST C routines. In order to end it, the task must be RESumed C after the PAUSE occurs. C PAUSE 'USRAST - Working...' C CALL CDKILL(1,STAT) IF (STAT(1).NE.1) CALL CDERRM(STAT,IERR) CALL CDCLOS(1,RCVPTC,STAT) IF (STAT(1).NE.1) CALL CDERRM(STAT,IERR) CALL CDUSER(,) C 90 TYPE 1001,' RCVCNT,XMTCNT,CMPERR = ',RCVCNT,XMTCNT,CMPERR TYPE 1001,' SIGCNT,MSGCNT,SIGERR = ',SIGCNT,MSGCNT,SIGERR CALL EXIT C 1000 FORMAT(' ERROR ON ',A,' DIRECTIVE: ',I5) 1001 FORMAT(/A,3I5) C END SUBROUTINE USRCMP(MBN) C C User completion routine called from AST C IMPLICIT INTEGER (A-Z) C PARAMETER (BUFSZ=4000, NBUFF=2) COMMON /BUFFER/ BUFF(BUFSZ,NBUFF) C Table of buffer numbers indexed by message block number COMMON /MBINDX/ MBI(NBUFF+1) COMMON /USRCMP/ RCVCNT,XMTCNT,CMPERR DATA RCVCNT,XMTCNT,CMPERR /3*0/ COMMON /PARAMS/ RCVPTC,XMTPTC,MAXWC C DIMENSION STAT(2) C D CALL DLOUTO(' Hello from USRCMP. MBN = ',MBN) CALL CDSTAT(MBN,INF,STAT) IBUF = MBI(MBN) IF(INF.EQ.3) THEN XMTCNT = XMTCNT + 1 IF(STAT(1).NE.1) CALL CDERRM(STAT,IERR) CALL CDRCV(1,RCVPTC,BUFF(1,IBUF),MAXWC,STAT) IF(STAT(1).NE.1) CALL CDERRM(STAT,IERR) MBI(STAT(2)) = IBUF ELSE IF(INF.EQ.4) THEN RCVCNT = RCVCNT + 1 IF(STAT(1).EQ.1) THEN XWC = STAT(2) CALL CDXMT(2,XMTPTC,BUFF(1,IBUF),XWC,STAT) IF(STAT(1).NE.1) CALL CDERRM(STAT,IERR) MBI(STAT(2)) = IBUF ELSE CALL CDERRM(STAT,IERR) CALL CDRCV(1,RCVPTC,BUFF(1,IBUF),MAXWC,STAT) IF(STAT(1).NE.1) CALL CDERRM(STAT,IERR) MBI(STAT(2)) = IBUF ENDIF ELSE CMPERR = CMPERR + 1 ENDIF RETURN END SUBROUTINE USRSIG(MBN) C C User signal/unsolicited message routine called from AST C IMPLICIT INTEGER (A-Z) C COMMON /USRSIG/ SIGCNT,MSGCNT,SIGERR DATA SIGCNT,MSGCNT,SIGERR /3*0/ C DIMENSION STAT(2) C D CALL DLOUTO(' Hello from USRSIG. MBN = ',MBN) CALL CDSTAT(MBN,INF,STAT) IF(INF.EQ.5) THEN MSGCNT = MSGCNT + 1 ELSE IF(INF.EQ.6) THEN SIGCNT = SIGCNT + 1 ELSE SIGERR = SIGERR + 1 ENDIF RETURN END