Google
 

Trailing-Edge - PDP-10 Archives - BB-H348C-RM_1982 - swskit-v21/demos/formir.for
There are no other files named formir.for in the archive.
c	This fortran program handles up to 4 logical links at one time.
c	On each link it will mirror all data sent to it.
c
	IMPLICIT INTEGER (A-H,O-Z)
	DIMENSION DESC(4),LINE(16)
	DATA DESC/'SRV:.','MIRRO','R    ',0/

c	 OPEN THE NETWORK FILES *

	CALL NFOPN (NETLN,0,'SRV:.MIRROR',7,0,RETCOD)
	IF(RETCOD.NE.0)GOTO 5000
	CALL NFOPN (NETLN,0,DESC,7,0,RETCOD)
	IF(RETCOD.NE.0)GOTO 5000
	CALL NFOPN (NETLN,0,DESC,7,0,RETCOD)
	IF(RETCOD.NE.0) GOTO 5000
	CALL NFOPN (NETLN,0,DESC,7,0,RETCOD)
	IF(RETCOD.NE.0)GOTO 5000

C	Here wait for something to happen on any of the logical links
c
100	NETLN=-1
	CALL NFGND (NETLN,1,RETCOD)
	IF(RETCOD.EQ.1)GOTO 200
	IF(RETCOD.EQ.2.OR.RETCOD.EQ.5)GOTO 300
	IF(RETCOD.EQ.3)GOTO 400
	IF(RETCOD.EQ.4)GOTO 500
	GOTO 5000

C	Here if a connect initiate was received
C
200	DO 210 I=1,16
210	LINE(I)=0
	CALL NFINF (NETLN,1,COUNT,LINE,RETCOD)
	WRITE(5,1000)
1000	FORMAT(' ACCEPTING CONNECTION FROM')
	WRITE(5,1010)LINE
1010	FORMAT(' NODE: ',16A5)
	DO220I=1,16
220	LINE(I)=0
	CALL NFINF (NETLN,2,COUNT,LINE,RETCOD)
	WRITE(5,1020)LINE
1020	FORMAT(' OBJECT TYPE: ',16A5)

C	Here if data was received
C
500	CALL NFRCV (NETLN,80,LINE,1,0,RETCOD)
	CALL NFSND (NETLN,80,LINE,1,RETCOD)
	GOTO100


C	Here if a disconnect was recieved
C
300	CALL NFCLS (NETLN,0,0,0,LINE,RETCOD)
	CALL NFOPN (NETLN,0,DESC,7,0,RETCOD)
	GOTO100

C	Here if an interrupt message was received
C
400	CALL NFRCI(NETLN,COUNT,LINE,RETCOD)
	WRITE(5,401)LINE
401	FORMAT(' Interrupt message =>',/,'	',16A5)
	GOTO 100

5000	WRITE(5,5001)
5001	FORMAT(' ?Fatal error')
	END