Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0084/rcvtst.for
There are no other files named rcvtst.for in the archive.
IMPLICIT INTEGER(A-Z)
LOGICAL RPTSWT,XITSWT
DIMENSION ARAY(100)
TYPE 100
100 FORMAT(' TTY NUMBER? '$)
ACCEPT 101,IOINDX
101 FORMAT(O)
IOINDX=IOINDX+"200000
CALL INIT(IOINDX,IERR,ITYPE)
IF(.NOT.IERR)GO TO 200
C
C ASSUME ONE MESSAGE TO BE RECEIVED, DON'T IGNORE ERRORS,
C AND MAXIMUM MESSAGE LENGTH.
C
N=72
RPTSWT=.FALSE.
XITSWT=.FALSE.
TYPE 102
ACCEPT 105,J
IF(J.EQ.'Y') RPTSWT=.TRUE.
TYPE 103
ACCEPT 105,J
IF(J.EQ.'Y') XITSWT=.TRUE.
102 FORMAT(' ACCEPT MULTIPLE MESSAGES (Y OR N)? '$)
103 FORMAT(' IGNORE ERRORS (Y OR N)? '$)
105 FORMAT(A1)
C
C NOW RECEIVE THE MESSAGE
C
130 CALL RECV(ARAY,N,IERR,ITYPE)
IF (.NOT.IERR)GO TO 300
IF(ITYPE.LE.0) GO TO 500
C
C TYPE THE RIGHT JUSTIFIED ASCII MESSAGE ON THE TERMINAL
C
135 DO 145 I=1,ITYPE
J=ARAY(I).AND."100
IX=(ARAY(I).AND."77)*"4000000000
ARAY(I)=IX.OR."1004020100
IF(J.NE.0) ARAY(I)=ARAY(I).OR."400000000000
145 CONTINUE
TYPE 151,(ARAY(I),I=1,ITYPE)
151 FORMAT(5X,100A1)
500 IF(RPTSWT) GO TO 130
CALL HNGUP
CALL EXIT
C
C AN INITIALIZATION ERROR OCCURRED
C
200 TYPE 110
IF (ITYPE.EQ.1)TYPE 111
IF (ITYPE.EQ.2)TYPE 112
CALL HNGUP
CALL EXIT
110 FORMAT(' ? TTY INITIALIZATION FAILURE')
111 FORMAT(' ? TTY NOT AVAILABLE')
112 FORMAT(' TTY NOT ASSIGNED')
C
C A RECEIVE ERROR OCCURRED
C
300 IF(.NOT.XITSWT) GO TO 305
TYPE 311
GO TO 130
305 TYPE 310
CALL HNGUP
CALL EXIT
310 FORMAT(/' ? MESSAGE COULD NOT BE RECEIVED')
311 FORMAT(' TIMEOUT - CONTINUING')
END