Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-04 - 43,50346/rcvtst.f4
There are no other files named rcvtst.f4 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