C*****************************************************************************
C
C                Forground/Background Job Communication Package
C	 		     Importable Functions
C
C-----------------------------------------------------------------------------
C
C Program	: Process Communication/ Prcom.For
C Author	: John Malcolmson
C Date		: July 1986
C Language	: Fortran 77
C Note		: Uses subroutines imported from both Syslib and RTNS 
C		  libraries.
C
C*****************************************************************************

C----------------------------------------------------------------------------)
C=============================== Procedures =================================)
C----------------------------------------------------------------------------)

C--------------------------------- GetMess ----------------------------------)
C
C   This gets a message from the foreground job and returns it as a WORD.
C	It also will cause the program call it to be aborted if no
C	foreground process exists.
C
C============================================================================)

	Function GetMess
		
		Integer*2	mess(2), GetMess, res, cnt

		cnt = 0

10		res = IrcvdW( mess, 1 )
		IF ((cnt .lt. 20).and.(res .ne. 0)) THEN
			cnt = cnt + 1
			Call Isleep( 00,00,02,00 )
			Goto 10
		END IF
		
		IF (res .ne. 0) Then
			Stop '- Fatal Error! : Timeout On No Foreground Job'
		END IF

		IF (mess(1) .ne. 1) Then
			write (5, 1001) mess
 1001	format(' Subroutine GETMESS: IRCVDW returned', 2I8)
			Stop '- Fatal Error! : Communications Failure'
		END IF
		
		GetMess = mess(2)

	End

C----------------------------------------------------------------------------)
	
C-------------------------------- SendMess ----------------------------------)
C
C   The SendMess routine sends a one word message to the foreground process.
C	If the foreground is not listening the program is aborted with
C	a fatal error.
C
C============================================================================)

	Subroutine SendMess( mess )
		
		Integer*2	mess, res

		res = IsdatW( mess, 1 )
		
		IF (res .ne. 0) Stop '- Fatal Error! : No Foreground Job'

	End

C----------------------------------------------------------------------------)

C-------------------------------- Floaded -----------------------------------)
C
C    This routine tests for the presence of the expected foreground job.
C	It then sends a special message to the foreground job asking it
C	if it is alright.  If the message fails or not message is returned
C	then drastic measures may be taken.
C
C============================================================================)

	Function Floaded
		
		Real*4		time
		Integer*2	mes, res, area(4), GetMess, Floaded
		External	Dostop

		Call Itimer( 00,00,05,00, area, 8, Dostop )
		mes = 10
		res = Isdatw( mes, 1 )

		IF (res .eq. 0) THEN
			res = GetMess()
			Call Icmkt( 8, time )
			IF (res .ne. 105) THEN
				Floaded = 1
			ELSE
				Floaded = 0
			END IF
		ELSE
			Call Icmkt( 8, time )
			Floaded = 2
		END IF

	END

	Subroutine DoStop( id )

		Integer*2	ID
		
		Call Print('Fatal Error : Job <Prtnr> is in an invalid state')
		Call Print('Libtst was not able to recover... Exiting')
		Call Exit

	END

C----------------------------------------------------------------------------)