C*****************************************************************************
C
C                  Test of RT-11 Services Syslib Routines.
C	 		     Importable Functions
C
C-----------------------------------------------------------------------------
C
C Program	: RT-11 Services/ RT11.For
C Author	: John Malcolmson
C Date		: June/July 1986
C Revised	: 11-Aug-89, IGTDUS test
C		: 16-Oct-89, Don't do LOOKUP test unless SYTASKing true
C Language	: Fortran 77
C Note		: Uses subroutines imported from both syslib and RTNS 
C		  libraries.
C
C*****************************************************************************

C*****************************************************************************
C
C List of functions:
C	<Chain>,  Device,  Gtjb,  Iaddr,  IDstat,   IFetch,   IFreer, Igetr
C	IGetr,    IGtDus,  IPeek, IPeekb, Ipoke,    Ipokeb,   IPut,   IQset
C	ISpy,     ITlock,  Lock,  LookUp, <Rchain>, Resume,  <Setcmd>, 
C	Suspnd,   Unlock,  Iprote,Iunpro
C
C*****************************************************************************


C---------------------------------- DEVICE -----------------------------------

	Function RtDevice

		Integer*4	RtDevice 
		Integer*2	res, loc, stts(4)
		Logical*2	SJ
	
		Call CentLn( '--- Testing DEVICE ---\' )
		Call CentLn( 'Specifies actions to be taken on completion\')
		RtDevice = 0

		IF ( SJ() ) THEN
			Call CentLn( '-- Not Supported Under SJ --\' )
			Goto 999
		END IF

		Call Irad50( 2, 'NL', dev )
		Call Idstat( dev, stts )
		loc = Ipeek( stts(3)+6 )
		IF (loc .ne. '260'O) THEN
			Call MtFail( 'device', 1 )
			Call Write2Int( '260'O, 10 )
			Call Write2Int( loc,    10 )
			Call WriteLn
			RtDevice = RtDevice + 2**1
		ELSE
			Call Ipoke( stts(3)+6, '240'O )
		END IF

999		Call TestFail( RtDevice )

		Call CentLn( '--- Testing DEVICE completed ---\' )
		Call WriteLn

	END

C-----------------------------------------------------------------------------

C------------------------------------ GTJB -----------------------------------

	Function RtGtjb

		Integer*4	RtGtjb
		Integer*2	res, GTJB, IGTJB, pb1(8), val
		Integer*2	pb2(12), bt1(3)
		Logical*2	SYTASK, MTTY, SJ, XM
		Byte		bt(6)
		
		Call CentLn( '--- Testing GTJB ---\' )
		Call CentLn( 'Returns job information\')
		RtGtjb = 0

	Call GTJB( pb1 )

		IF ((pb1(1) .lt. 0).or.(pb1(1).gt.16)) THEN
			Call MtFail( 'rngchk', 1 )
			Call Write2Int( 0,      10 )
			Call Write2Int( pb1(1), 10 )
			Call WriteLn
			RtGtjb = RtGtJb + 2**1
		END IF

		IF ( SJ() ) THEN
			IF (pb1(5) .ne. 0) THEN
				Call MtFail( 'zerovl', 2 )
				Call Write2Int( 0,      10 )
				Call Write2Int( pb1(5), 10 )
				Call WriteLn
				RtGtjb = RtGtjb + 2**2
			END IF
		ELSE
			IF (pb1(5) .eq. 0) THEN
				Call MtFail( 'impure', 3 )
				Call Write2Int( 1,      10 )
				Call Write2Int( pb1(5), 10 )
				Call WriteLn
				RtGtjb = RtGtjb + 2**3
			END IF
		END IF

		IF ( .NOT.MTTY() ) THEN
			IF (pb1(6) .ne. 0) THEN
				Call MtFail( 'mlttrm', 4 )
				Call Write2Int( 0, 10 )
				Call Write2Int( pb1(6), 10 )
				Call WriteLn
				RtGtjb = RtGtjb + 2**4
			END IF
		END IF

	Call GTJB( pb2, -1 )

		IF ((pb2(1) .lt. 0).or.(pb2(1) .gt. 16)) THEN
			Call MtFail( 'rngchk', 5 )
			Call Write2Int( 0,      10 )
			Call Write2Int( pb2(1), 10 )
			Call WriteLn
			RtGtjb = RtGtJb + 2**5
		END IF

		IF ( SJ() ) THEN
			IF (pb2(5) .ne. 0) THEN
				Call MtFail( 'zerovl', 6 )
				Call Write2Int( 0,      10 )
				Call Write2Int( pb2(5), 10 )
				Call WriteLn
				RtGtjb = RtGtjb + 2**6
			END IF
		ELSE
			IF (pb2(5) .eq. 0) THEN
				Call MtFail( 'impure', 7 )
				Call Write2Int( 1,      10 )
				Call Write2Int( pb2(5), 10 )
				Call WriteLn
				RtGtjb = RtGtjb + 2**7
			END IF
		END IF

		IF ( .NOT.MTTY() ) THEN
			IF (pb2(6) .ne. 0) THEN
				Call MtFail( 'mlttrm', 8 )
				Call Write2Int( 0, 10 )
				Call Write2Int( pb2(6), 10 )
				Call WriteLn
				RtGtjb = RtGtjb + 2**8
			END IF
		END IF

		IF ( SYTASK() ) THEN
			res = GTJB( pb2, IADDR( pb2(10)))
			IF (res .ne. 0) THEN
				Call MtFail( 'namelk', 9 )
				Call Write2Int( 0,   10 )
				Call Write2Int( res, 10 )
				Call WriteLn
				RtGtjb = RtGtjb + 2**9
			END IF
C
			bt1(1) = 1
			bt1(2) = 1
			bt1(3) = 0
			res = GTJB( pb2, IADDR( bt1))
			IF (res .ne. -1) THEN
				Call Mtfail( 'namelk', 10 )
				Call Write2Int( -1,  10 )
				Call Write2Int( res, 10 )
				Call WriteLn
				RtGtjb = RtGtjb + 2**10
			END IF

		END IF

999		Call TestFail( RtGtjb )

		Call CentLn( '--- Testing GTJB completed ---\' )
		Call WriteLn

	END

C-----------------------------------------------------------------------------

C----------------------------------- IADDR -----------------------------------

	Function RtIaddr

		Integer*4	RtIaddr
		Integer*2	argm, res, val

		Call CentLn( '--- Testing IADDR ---\' )
		Call CentLn(
	1 'Obtains the virtual address of the argument\')
		RtIaddr = 0
			
		argm = 10
		res  = IADDR( argm )
		Call Ipoke( res, 15 )
		IF (argm .eq. 10) THEN
			Call MtFail( 'update', 1 )
			Call Write2Int( 15,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIaddr = RtIaddr + 2**1
		END IF

		IF (argm .ne. 15) THEN
			Call MtFail( 'update', 2 )
			Call Write2Int( 15,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIaddr = RtIaddr + 2**2
		END IF

		Call TestFail( RtIaddr )

		Call CentLn( '--- Testing IADDR completed ---\' )
		Call WriteLn

	END

C-----------------------------------------------------------------------------

C----------------------------------- IDSTAT ----------------------------------

	Function RtIdstat

		Integer*4	RtIdstat
		Real*4		dev
		Integer*2	Status(4), res, Idstat

		Call CentLn( '--- Testing IDSTAT ---\' )
		Call CentLn(
	1 'Returns status of the specified device\')
		RtIdstat = 0
                
		Call Irad50( 2, 'NL', dev )
		res = Idstat( dev, status )
		IF (res .ne. 0) THEN
			Call Mtfail( 'idstat', 1 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIdstat = RtIdstat + 2**1
		ELSE
			Call CentLn('The Status Block is as follows:\' )
			Call WriteString( ' \', 30, 1 )
			Call Wbinary( 1+Status(1)-1, 16 )
			Call WriteChar( 'B' )
			Call WriteLn
			Call WriteString( ' \', 32, 1 )
			Call Write2Int( Status(2), 14 )
			Call WriteChar( 'D' )
			Call WriteLn
			Call WriteString( ' \', 32, 1 )
			Call Writ2Oct( Status(3), 14 )
			Call WriteChar( 'O' )
			Call WriteLn
			Call WriteString( ' \', 32, 1 )
			Call Write2Int( Status(4), 14 )
			Call WriteChar( 'D' )
			Call WriteLn

		END IF

		Call Irad50( 2, 'QQ', dev )
		res = Idstat( dev, status )
		IF (res .ne. 1) THEN
			Call Rsltfail( 2 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIdstat = RtIdstat + 2**2
		END IF

		Call TestFail( RtIdstat )

		Call CentLn( '--- Testing IDSTAT completed ---\' )
		Call WriteLn

	END

C-----------------------------------------------------------------------------

C----------------------------------- IFETCH ----------------------------------

	Function RtIfetch

		Integer*4	RtIfetch
		Real*4		dev
		Integer*2	res

		Call CentLn( '--- Testing IFETCH ---\' )
		Call CentLn( 'Loads devices handlers into memory\')
		RtIfetch = 0

		Call Irad50( 2, 'LD', dev )
		res = Ifetch( dev )
		IF (res .ne. 0) THEN
			Call Mtfail( 'fetch', 1 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIfetch = RtIfetch + 2**1
		END IF

		Call Irad50( 2, 'QQ', dev )
		res = Ifetch( dev )
		IF (res .ne. 1) THEN
			Call Rsltfail( 2 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIfetch = RtIfetch + 2**2
		END IF

		Call TestFail( RtIfetch )

		Call CentLn( '--- Testing IFETCH completed ---\' )
		Call WriteLn

	END

C---------------------------------- IFREER -----------------------------------

	Function RtIFreer

		Integer*4	RtIFreer, Rname
		Integer*2	i, res, Wrka(7), Argue, Arguement(0:0)
		Logical*2	XM

		Call CentLn( '--- Testing IFREER ---\' )
		Call CentLn( 'Eliminates a global region\')
		RtIfreer = 0

		IF ( .NOT. XM() ) THEN
			Call CentLn( '-- Only Supported Under XM --\' )
			Goto 999
		END IF
	
		Argue = ('120000'O - IADDR( arguement(0))) / 2

		Rname = 0
		Call IRAD50( 6, 'REYJUN', rname )
		Res = IGETR( wrka, 'A', rname, Arguement(argue), 128, 0, 0 )
		IF (res .ne. 0) THEN
			Call MtFail( 'igetr', 1 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIfreer = RtIfreer + 2**1
		END IF

		res = Ifreer( wrka, 'E' )
		IF (res .ne. 0) THEN
			Call MtFail( 'ifreer', 2 )
			Call Write2Int( 0,   10 )
			Call write2Int( res, 10 )
			Call WriteLn
			RtIfreer = RtIfreer + 2**2
		END IF

		Rname = 0
		Call Irad50( 6, 'REYJUN', rname )
		Res = Igetr( wrka, 'S', rname, Arguement(argue), 128, 0, 0 )
		IF (res .ne. 0) THEN
			Call MtFail( 'igetr', 3 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIfreer = RtIfreer + 2**3
		END IF

		res = Ifreer( wrka )
		IF (res .ne. 0) THEN
			Call MtFail( 'ifreer', 4 )
			Call Write2Int( 0,   10 )
			Call write2Int( res, 10 )
			Call WriteLn
			RtIfreer = RtIfreer + 2**4
		END IF

		Rname = 0
		Call Irad50( 6, 'REYJUN', rname )
		Res = Igetr( wrka, 'S', rname, Arguement(argue) )
		IF (res .ne. 0) THEN
			Call MtFail( 'igetr', 5 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIfreer = RtIfreer + 2**5
		END IF

		res = Ifreer( wrka, 'E' )
		IF (res .ne. 0) THEN
			Call MtFail( 'ifreer', 6 )
			Call Write2Int( 0,   10 )
			Call write2Int( res, 10 )
			Call WriteLn
			RtIfreer = RtIfreer + 2**6
		END IF

999		Call TestFail( RtIfreer )

		Call CentLn( '--- Testing IFREER completed ---\' )
		Call WriteLn

	END

C----------------------------------- IGETR -----------------------------------

	Function RtIgetr

		External	Qazwsx
		Integer*4	RtIgetr
		Integer*2	res, i, j, Fail
		Integer*2	wrka(7), Argue, Argument(0:0)
		Integer*4	rname
		Real*8		Spec
		Logical*2	XM

		Call CentLn( '--- Testing IGETR ---\' )
		Call CentLn( 'Creates a global region\' )
		RtIgetr = 0

		IF ( .NOT. XM() ) THEN
			Call CentLn( '-- Only Supported Under XM --\' )
			Goto 999
		END IF

		argue = ('120000'O - Iaddr(argument(0))) / 2

		rname = 0
		Call Irad50( 6, 'REYJUN', rname )
		res = IGetr( wrka, 'A', rname, Argument(Argue) )

		IF (res .ne. -11) THEN
			Call MtFail( 'igetr', 1 )
			Call Write2Int( -11, 10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIgetr = RtIgetr + 2**1
		END IF

		res = IGetr( wrka, 'P', rname, Argument(Argue), 128, 0, 0 )

		IF (res .ne. 0) THEN
			Call MtFail( 'igetr', 2 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIgetr = RtIgetr + 2**2
		END IF

		res = Ifreer( wrka, 'E' )
		IF (res .ne. 0) THEN
			Call MtFail( 'ifreer', 3 )
			Call Write2Int( 0,    10 )
			Call write2Int( res,  10 )
			Call WriteLn
			RtIgetr = RtIgetr + 2**3
		END IF

		Call Irad50( 12, 'DATTIGETRTXT', Spec )
		res = IGetr( wrka,'A',rname,Argument(Argue),128,0,0,Spec,0 )
		IF (res .ne. 0) THEN
			Call MtFail( 'igetr', 4 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIgetr = RtIgetr + 2**4
		END IF
		
		Fail = 0
		DO 30 i = 0, 127
			IF (Argument(argue+i) .ne. -1) THEN
				Fail = i
				Goto 31
			END IF
30		Continue

31		IF (Fail .ne. 0) THEN
			Call IMtFail( 'region',                 05 )
			Call Write2Int( fail,                   06 )
			Call Write2Int( -1,                     10 )
			Call Write2Int( Argument(Arugue+fail), 10 )
			Call WriteLn
			RtIgetr = RtIgetr + 2**5
		END IF

		res = Ifreer( wrka, 'E' )
		IF (res .ne. 0) THEN
			Call MtFail( 'ifreer', 6 )
			Call Write2Int( 0,    10 )
			Call write2Int( res,  10 )
			Call WriteLn
			RtIgetr = RtIgetr + 2**6
		END IF

32		Ichan = Igetc()
		IF (Ichan .lt. 0) Goto 32
		Call Irad50( 12, 'DATTIGETRTXT', Spec )
		res = LookUp( Ichan, Spec )
		IF (res .le. 0) THEN
			Call MtFail( 'lookup', 7 )
			Call Write2Int( 0,    10 )
			Call Write2Int( res,  10 )
			Call WriteLn
			RtIgetr = RtIgetr + 2**7
		END IF

		res = IGetr( wrka,'A',rname,Argument(Argue),128,0,0,Ichan,0)
		IF (res .ne. 0) THEN
			Call MtFail( 'igetr', 8 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIgetr = RtIgetr + 2**8
		END IF

		Call Closec( Ichan )
		Call Ifreec( Ichan )
				
		Fail = 0
		DO 40 i = 0, 127
			IF (Argument(Argue+i) .ne. -1) THEN
				Fail = i
				Goto 41
			END IF
40		Continue

41		IF ( Fail .ne. 0 ) THEN
			Call IMtFail( 'region',                09 )
			Call Write2Int( fail,                  06 )
			Call Write2Int( -1,                    10 )
			Call Write2Int( Argument(Argue+fail), 10 )
			Call WriteLn
			RtIgetr = RtIgetr + 2**9
		END IF

		res = Ifreer( wrka, 'E' )
		IF (res .ne. 0) THEN
			Call MtFail( 'ifreer', 10 )
			Call Write2Int( 0,     10 )
			Call write2Int( res,   10 )
			Call WriteLn
			RtIgetr = RtIgetr + 2**10
		END IF

		res = IGetr(wrka,'A',rname,Argument(Argue),128,0,0,qazwsx,-1)
		IF (res .ne. 0) THEN
			Call MtFail( 'igetr', 11 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIgetr = RtIgetr + 2**11
		END IF

		Fail = 0
		DO 50 i = 0, 127
			IF (Argument(Argue+i) .ne. i) THEN
				Fail = i
				Goto 51
			END IF
50		Continue

51		IF ( Fail .ne. 0 ) THEN
			Call IMtFail( 'region',                12 )
			Call Write2Int( fail,                  06 )
			Call Write2Int( fail,                  10 )
			Call Write2Int( Argument(Argue+fail), 10 )
			Call WriteLn
			RtIgetr = RtIgetr + 2**12
		END IF

		res = Ifreer( wrka, 'E' )
		IF (res .ne. 0) THEN
			Call MtFail( 'ifreer', 13 )
			Call Write2Int( 0,     10 )
			Call write2Int( res,   10 )
			Call WriteLn
			RtIgetr = RtIgetr + 2**13
		END IF

999		Call TestFail( RtIgetr )

		Call CentLn( '--- Testing IGETR completed ---\' )
		Call WriteLn

	END


	Subroutine qazwsx( addr, ln )

		Integer*2	i, addr, ln

		DO 10 i = 0, Ln-1
			Call IPOKE( Addr+(2*i), i )
10		Continue

	End

C---------------------------------- IGTDUS -----------------------------------

	Function RtIgtdus

		Integer*4	RtIgtdus
		Integer*2	Ichan, Devnam, stts(7), work(80), res
		Integer*2	cnt

		Data	Devnam / 3rDU0 /

		Call CentLn( '--- Testing IGTDUS ---\' )
		Call CentLn( 'Returns DU information\')
		RtIgtdus = 0

		Ichan = Igetc()
		cnt   = 0

   10		res = IGTDUS( devnam, Ichan, stts,,, work )
		cnt = cnt + 1			! count attempts

		IF (res .eq. 0) Goto 100	! Success?

		IF (res .gt. -4) Call CentLn( 'Logic Error\')

		IF (res .eq. -5) Call CentLn( 'Hard Error on channel\')

c  No such device handler?

		IF (res .eq. -14) THEN
			Call CentLn(
	1 '*** No such device DU0: -- IGTDUS test NOT PERFORMED ***')
			Goto 990
		END IF

c  Handler not loaded?

		IF (res .eq. -13) THEN
			IF (cnt .eq. 1) THEN	! first time through?
				i = IFETCH( Devnam)	! try to fetch it,
				if (i .eq. 0) goto 10	! and try again
				call CentLn(
	1 '*** DU handler WON''T FETCH - IGTDUS test NOT PERFORMED ***')
				go to 990
			ELSE
				Call CheckX( '\',
	1		2,			! pass = 2
	2		'Load? ',		! short failure message
	3		0,			! expected result
	4		-13,			! test value
	5		res,			! actual result
	6		'NE',			! hopefully Not Equal
	7		RtIgtdus )		! status accumulator

			ENDIF
		END IF

c  What kind of error was it?

		Call CheckX( '\',
	1		3,			! pass = 3
	2		'Error ',		! short failure message
	3		0,			! expected result
	4		0,			! test value
	5		res,			! actual result
	6		'EQ',			! hopefully EQ 0
	7		RtIgtdus )		! status accumulator
		go to 980

c  Come here only upon success

  100		Call CentLn( 'The Status Block is as follows:\' )
		Call WriteString( ' \', 30, 1 )
		Call Wbinary(     1+Stts(1)-1, 16 )
		Call WriteChar(  'B' )
		Call WriteLn
		Call WriteString( ' \', 32, 1 )
		Call Writ2Oct(   stts(2), 14 )
		Call WriteChar(  'O' )
		Call WriteLn
		Call WriteString( ' \', 32, 1 )
		stts(4) = IIAnd(  Stts(4), (2**13)-1 )
		Call WriteOct(    Stts(3), 14 )
		Call WriteChar(  'O' )
		Call WriteLn
		Call WriteString( Stts(5), 38, 6 )
		Call WriteLn
	
  980		Call TestFail( RtIgtdus )

		Call CentLn( '--- Testing IGTDUS completed ---\' )
  990		Call WriteLn

	END

C----------------------------------- IPEEK -----------------------------------

	Function RtIpeek

		Integer*4	RtIpeek
		Integer*2	arg, res, val

		Call CentLn( '--- Testing IPEEK ---\' )
		Call CentLn( 'Returns the contents of the memory location\')
		RtIpeek = 0

		arg = 10
		val = Iaddr( arg )
		res = Ipeek( val )
		IF (res .ne. arg) THEN
			Call MtFail( 'peekng', 1 )
			Call Write2Int( 10,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIpeek = RtIpeek + 2**1
		END IF

		arg = 257
		val = Iaddr( arg )
		res = Ipeek( val )
		IF (res .ne. arg) THEN
			Call MtFail( 'peekng', 2 )
			Call Write2Int( 257, 10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIpeek = RtIpeek + 2**2
		END IF

		Call TestFail( RtIpeek )

		Call CentLn( '--- Testing IPEEK completed ---\' )
		Call WriteLn

	END

C----------------------------------- IPEEKB ----------------------------------

	Function RtIbpeek

		Integer*4	RtIbpeek
		Byte		arg, res
		Integer*2	val

		Call CentLn( '--- Testing IPEEKB ---\' )
		Call CentLn( 'Returns the contents of a byte in memory\')
		RtIbpeek = 0

		arg = 10
		val = Iaddr(  arg )
		res = Ipeekb( val )
		IF (res .ne. arg) THEN
			Call MtFail( 'peekng', 1 )
			Call Write2Int( 10,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIbpeek = RtIbpeek + 2**1
		END IF

		arg = 247
		val = Iaddr(  arg )
		res = Ipeekb( val )
		IF (res .ne. arg) THEN
			Call MtFail( 'peekng', 2 )
			Call Write2Int( 247, 10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIbpeek = RtIbpeek + 2**2
		END IF

		Call TestFail( RtIbpeek )

		Call CentLn( '--- Testing IPEEKB completed ---\' )
		Call WriteLn

	END

C----------------------------------- IPOKE -----------------------------------

	Function RtIpoke

		Integer*4	RtIpoke
		Integer*2	arg, val, res

		Call CentLn( '--- Testing IPOKE ---\' )
		Call CentLn( 'Stores a word into memory\')
		RtIpoke = 0

		arg = 10
		val = Iaddr( arg )
		Call IPoke(  val, 15 )
		res = Ipeek( val )
		IF (res .ne. arg) THEN
			Call MtFail( 'pokeng', 1 )
			Call Write2Int( arg, 10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIpoke = RtIpoke + 2**1
		END IF

		arg = 257
		val = Iaddr( arg )
		Call Ipoke(  val, 75 )
		res = Ipeek( val )
		IF (res .ne. arg) THEN
			Call MtFail( 'pokeng', 2 )
			Call Write2Int( arg, 10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIpoke = RtIpoke + 2**2
		END IF

		Call TestFail( RtIpoke )

		Call CentLn( '--- Testing IPOKE completed ---\' )
		Call WriteLn

	END

C----------------------------------- IPOKEB ----------------------------------

	Function RtIbpoke

		Integer*4	RtIbpoke
		Byte		arg
		Integer*2	val, res, carg
	
		Call CentLn( '--- Testing IPOKEB ---\' )
		Call CentLn( 'Stores a word in memory\')
		RtIbpoke = 0

		arg  = 10
		val  = Iaddr(  arg )
		Call IPokeb(   val, 15 )
		res  = Ipeekb( val )
		carg = arg
		IF (res .ne. carg) THEN
			Call MtFail( 'pokeng', 1 )
			Call Write2Int( carg, 10 )
			Call Write2Int( res,  10 )
			Call WriteLn
			RtIbpoke = RtIbpoke + 2**1
		END IF

		arg  = 247
		val  = Iaddr(  arg )
		Call Ipokeb(   val, 75 )
		res  = Ipeekb( val )
		carg = arg
		IF (res .ne. carg) THEN
			Call MtFail( 'pokeng', 2 )
			Call Write2Int( carg, 10 )
			Call Write2Int( res,  10 )
			Call WriteLn
			RtIbpoke = RtIbpoke + 2**2
		END IF

		Call TestFail( RtIbpoke )

		Call CentLn( '--- Testing IPOKEB completed ---\' )
		Call WriteLn

	END

C------------------------------------ IPUT -----------------------------------

	Function RtIput

		Integer*4	RtIput
		Integer*2	res, new, val, str

		Call CentLn( '--- Testing IPUT ---\' )
		Call CentLn( 
	1	'Updates the contents of a mon fixed offset\')
		RtIput = 0
	
		str = Ispy( '300'O )
		res = Iput( '300'O, 0 )
		new = Ispy( '300'O )
		val = Iput( '300'O, str )
	
		IF (str .ne. res) THEN
			Call MtFail( 'result', 1 )
			Call Write2Int( str, 10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIput = RtIput + 2**1
		END IF

		IF (new .ne. 0) THEN
			Call MtFail( 'assign', 2 )
			Call Write2Int( 0,   10 )
			Call Write2Int( new, 10 )
			Call WriteLn
			RtIput = RtIput + 2**2
		END IF

		IF (val .ne. 0) THEN
			Call MtFail( 'result', 3 )
			Call Write2Int( 0,   10 )
			Call Write2Int( val, 10 )
			Call WriteLn
			RtIput = RtIput + 2**3
		END IF

		IF (val .ne. new) THEN
			Call MtFail( 'result', 4 )
			Call Write2Int( new, 10 )
			Call Write2Int( val, 10 )
			Call WriteLn
			RtIput = RtIput + 2**4
		END IF

		Call TestFail( RtIput )

		Call CentLn( '--- Testing IPUT completed ---\' )
		Call WriteLn

	END

C---------------------------------- IQSET ------------------------------------

	Function RtIqset

		External	poiuyt
		Integer*4	RtIqset, Tim
		Integer*2	res, cnt, cnt1, val
		Logical*2	SJ
		Real*8		area(20)

		Call CentLn( '--- Testing IQSET ---\' )
c
		Call CentLn(
	1	 'Expands the size of the queue element pool\')
		RtIqset = 0

c  Determine how many queue elements are available by default.		
c  Each call to ITIMER uses another queue element.  Loop until the
c  result code indicates NO_QUEUE_ELEMENTS available.

		cnt = 0
10		res = ITIMER( 6, 6, 6, 0, area(cnt+1), cnt, poiuyt )
		IF (res .eq. 0) THEN
			cnt = cnt + 1
			Goto 10
		END IF

c  Cancel the timers, and report the number of queue elements
c  that were available.

		Call ICMKT( 0, tim )

		Call CentLn( 'Queue Element Pool Size\' )
		Call WriteString( ' \', 38, 1 )
		Call Write2Int( cnt, 2 )
		Call WriteLn

c  Test IQSET by using it to reserve 5 queue elements.  Then use
c  ITIMER to eat up what remains.

	Call IQSET( 5 )

		cnt1 = 0
20		res = ITIMER( 6, 6, 6, 0, area(cnt1+1), cnt1, poiuyt )
		IF (res .eq. 0) THEN
			cnt1 = cnt1 + 1
			Goto 20
		END IF

c  Cancel the timers, and report the number of queue elements
c  that were available.

		Call ICMKT( 0, tim )

		Call CentLn( 'New Queue Element Pool Size\' )
		Call WriteString( ' \', 38, 1 )
		Call Write2Int( cnt1, 2 )
		Call WriteLn

c  Report errors

		IF (cnt+5 .ne. cnt1) THEN
			Call Mtfail( 'pextnd', 1 )
			Call Write2Int( cnt+2, 10 )
			Call Write2Int( cnt1,  10 )
			Call WriteLn
			RtIqset = RtIqset + 2**1
		END IF

999		Call TestFail( RtIqset )

		Call CentLn( '--- Testing IQSET completed ---\' )
		Call WriteLn

	END

	Subroutine POIUYT( i )
		Integer*2 i
		Call Print( 'completion routine entered for ITIMER' )
	END

C----------------------------------- ISPY ------------------------------------

	Function RtIspy

		Integer*4	RtIspy
		Integer*2	new, val, res, str

		Call CentLn( '--- Testing ISPY ---\' )
		Call CentLn( 'Returns the value of a monitor offset\')
		RtIspy = 0
	
		res = Iput( '300'O, 0 )
		str = Ispy( '300'O )
		val = Iput( '300'O, res )
		new = Ispy( '300'O )
	
		IF (str .eq. res) THEN
			Call MtFail( 'result', 1 )
			Call Write2Int( str, 10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtIspy = Rtspy + 2**1
		END IF

		IF (str .ne. 0) THEN
			Call MtFail( 'lookup', 2 )
			Call Write2Int( 0,   10 )
			Call Write2Int( new, 10 )
			Call WriteLn
			RtIspy = RtIspy + 2**2
		END IF

		IF (new .eq. 0) THEN
			Call MtFail( 'result', 3 )
			Call Write2Int( 0,   10 )
			Call Write2Int( val, 10 )
			Call WriteLn
			RtIspy = RtIspy + 2**3
		END IF

		IF (res .ne. new) THEN
			Call MtFail( 'lookup', 4 )
			Call Write2Int( new, 10 )
			Call Write2Int( val, 10 )
			Call WriteLn
			RtIspy = RtIspy + 2**4
		END IF

		Call TestFail( RtIspy )

		Call CentLn( '--- Testing ISPY completed ---\' )
		Call WriteLn

	END

C----------------------------------- ITLOCK ----------------------------------

	Function RtItlock

		Integer*4	RtItlock
		integer*2	res
		Logical*2	SJ

		Call CentLn( '--- Testing ITLOCK ---\' )
		Call CentLn('Indicates if the USR is in use and locks\')
		RtItlock = 0
		
		IF ( SJ() ) THEN
			Call CentLn( '-- Not Supported Under SJ --\' )
			Goto 999
		END IF

		res = Itlock()

		IF ((res .gt. 1).or.(res .lt. 0)) THEN
			Call MtFail( 'rngchk', 1 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtItlock = RtItlock + 2**1
		END IF

		IF (res .eq. 0) Call Unlock

999		Call TestFail( RtItlock )

		Call CentLn( '--- Testing ITLOCK completed ---\' )
		Call WriteLn

	END

C------------------------------------ LOCK -----------------------------------

	Function RtLock

		Integer*4	RtLock
		Integer*2	res, getmess
		Logical*2	SJ

		Call CentLn( '--- Testing LOCK ---\' )
		Call CentLn( 'Makes the USR resident\')
		RtLock = 0

		IF ( SJ() ) THEN
			Call CentLn( '-- Not Testable Under SJ --\' )
			Goto 999
		END IF

C		Ask the partner job to lock the USR
		Call CentLn( 'Partner will lock the USR\' )
		Call SendMess( 2 )
		res = GetMess()
		IF (res .ne. 25) THEN
			Call Mtfail( 'commun', 1 )
			Call Write2Int( 25,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			Rtlock = Rtlock + 2**1
		END IF
		res = Itlock()
		IF (res .ne. 1) THEN
			Call MtFail( 'lockng', 2 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			Rtlock = RtLock + 2**2
		END IF

C		Ask the partner job to unlock the USR
		IF (res .eq. 1) THEN
			Call CentLn( 'Partner will unlock the USR\' )
			Call SendMess( 3 )
			res = GetMess()
			IF (res .ne. 35) THEN
				Call Mtfail( 'commun', 3 )
				Call Write2Int( 35,  10 )
				Call Write2Int( res, 10 )
				Call WriteLn
				Rtlock = Rtlock + 2**3
			END IF
		END IF

999		Call TestFail( RtLock )

		Call CentLn( '--- Testing LOCK completed ---\' )
		Call WriteLn

	END

C-----------------------------------------------------------------------------

C----------------------------------- LOOKUP ----------------------------------

	Function RtLookup

		Integer*4	RtLookup
		BYTE		JobName(8)
		Integer*2	resa, Ichan
c		Integer*2	Envior
		Logical*2	SYTASK

		Call CentLn( '--- Testing LOOKUP ---\' )
		Call CentLn( 'Opens a system job for I/O\')
		RtLookup = 0

		IF ( .NOT. SYTASK() ) THEN
			Call CentLn(
	1	'-- System Tasking Not Supported on This Monitor --\' )
			Goto 999
		END IF

		Ichan = IGetC()
		Call Closec( Ichan )
		Call IRad50( 2, 'MQ', JobName )
		Call Scopy( 'PRTNR',  JobName(3), 5 )
		JobName(8) = 0
		resa = Lookup( Ichan, JobName )
		IF (resa .lt. 0) THEN
			Call MtFail( 'chkjob', 1 )
			Call Write2Int( 1,    10 )
			Call Write2Int( resa, 10 )
			Call WriteLn
			RtLookup = RtLookup + 2**1
		END IF

		Call Closec( Ichan )
		Call IRad50( 2, 'MQ', JobName )
		Call Scopy( 'XXXXXX', JobName(3), 6 )
		resa = Lookup( Ichan, JobName )
		IF (resa .gt. 0) THEN
			Call MtFail( 'misjob', 2 )
			Call Write2Int( -2,   10 )
			Call Write2Int( resa, 10 )
			Call WriteLn
			RtLookup = RtLookup + 2**2
		END IF

		Call Closec( Ichan )
		Call Ifreec( Ichan )

999		Call TestFail( RtLookup )

		Call CentLn( '--- Testing LOOKUP completed ---\' )
		Call WriteLn

	END

C---------------------------------- RESUME -----------------------------------

	Function RtResume

		Integer*4	RtResume, time
		Integer*2	Area(4), res
		Character*80	st
		Logical*2	SJ
		External	plmokn

		Call CentLn( '--- Testing RESUME ---\' )
		Call CentLn( 'Resumes a suspended job\')
		RtResume = 0

		IF ( SJ() ) THEN
			Call CentLn('- Not Supported under SJ -\' )
			Goto 999
		END IF
		
		Call Itimer( 00,00,02,00,area,1,plmokn )

		Call Suspnd

		res = Icmkt( 1, time )
		IF (res .ne. 1) THEN
			Call MtFail( 'suspnd', 1 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtResume = RtResume + 2**1
		END IF

999		Call TestFail( RtResume )

		Call CentLn( '--- Testing RESUME completed ---\' )
		Call WriteLn

	END

C----------------------------------- SUSPND ----------------------------------

	Function RtSuspnd

		Integer*4	RtSuspnd, time
		Integer*2	Area(4), res
		Character*80	st
		Logical*2	SJ
		External	plmokn

		Call CentLn( '--- Testing SUSPND ---\' )
		Call CentLn( 'Suspends execution of the main process\')
		RtSuspnd = 0

		IF ( SJ() ) THEN
			Call CentLn('- Not Supported under SJ -\' )
			Goto 999
		END IF

		Call Itimer( 00,00,02,00,area,1,plmokn )

		Call Suspnd

		res = Icmkt( 1,time )
		IF (res .ne. 1) THEN
			Call MtFail( 'suspnd', 1 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtSuspnd = RtSuspnd + 2**1
		END IF

999		Call TestFail( RtSuspnd )

		Call CentLn( '--- Testing SUSPND completed ---\' )
		Call WriteLn
		
	END
	
	Subroutine plmokn( id )
		Integer*2 id
		Call Resume
	END

C----------------------------------- UNLOCK ----------------------------------

	Function RtUnlock

		Integer*4	RtUnlock
		Integer*2	res, getmess
		Logical*2	SJ

		Call CentLn( '--- Testing UNLOCK ---\' )
		Call CentLn( 'Releases the USR if lock was performed\')
		RtUnlock = 0

		IF ( SJ() ) THEN
			Call CentLn( '-- Not Testable Under SJ --\' )
			Goto 999
		END IF

C		Ask the partner job to lock the USR
		Call SendMess( 2 )
		res = GetMess()
		IF (res .ne. 25) THEN
			Call Mtfail( 'commun', 1 )
			Call Write2Int( 25,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtUnLock = RtUnLock + 2**1
		END IF

		res = Itlock()
		IF (res .ne. 1) THEN
			Call MtFail( 'lockng', 2 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtUnLock = RtUnLock + 2**2
		END IF

C		Ask the partner job to unlock the USR
		Call SendMess( 3 )
		res = GetMess()
		IF (res .ne. 35) THEN
			Call Mtfail( 'commun', 3 )
			Call Write2Int( 35,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtUnLock = RtUnLock + 2**3
		END IF

		res = Itlock()
		IF (res .ne. 0) THEN
			Call MtFail( 'unlock', 4 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			RtUnLock = RtUnLock + 2**4
		END IF

C		Ask the partner job to unlock the USR
		IF (res .eq. 1) THEN
			Call SendMess( 3 )
			res = GetMess()
			IF (res .ne. 35) THEN
				Call Mtfail( 'commun', 5 )
				Call Write2Int( 35,  10 )
				Call Write2Int( res, 10 )
				Call WriteLn
				RtUnLock = RtUnLock + 2**5
			END IF
		END IF

999		Call TestFail( RtUnlock )

		Call CentLn( '--- Testing UNLOCK completed ---\' )
		Call WriteLn

	END

C-------------------------------- RtIprote ----------------------------------
C
C	RtIprote --- Test program for the IPROTE Syslib Routine.
C
C	Program      :
C	Author       : I. B. Sokari
C	Date	     : August 1988
C	Edited By    :
C	Date Edited  :
C	Language     : Fortran 77
C	Notes	     : Uses subroutines from both Syslib and RTNS libraries.
C
C=============================================================================

	Function   RtIprote

C
C		Program Declarations
C
	Integer*4	RtIprote

	Integer*2	val, Config, BFbit, j, addr, res

C
C		Program Initializations
C
	DATA		Config /"300/
	DATA		BFbit /"1/

	RtIprote = 0

C
C		Main Program code
C

	Call CentLn( '--- Testing IPROTE Syslib Routine ---\')
	Call CentLn( 'Protects the address of a two-word vector\')
 
C
C	Check the monitor before performing test. IPROTE is only for
C	FB and XM monitors
C

	J = ISPY( Config )

	IF (( J .AND. BFbit ) .EQ. 0 ) THEN		! SJ Monitor; don't
							! perform test.
	   Call WriteLn
	   Call CentLn( '===============================================
     1===\')
	   Call CentLn( ' ?IPROTE-I-Test not Performed \')
	   Call CentLn( ' IPROTE is a special feature in FB/XM only \')
	   Call CentLn( '===============================================
     1===\')

	   GO TO 999

	ELSE						! Perform test

	   addr = "40					! = 32(decimal) 

	   res = IPROTE( addr )

	   IF ( res .ne. 0 ) THEN
	      Call MtFail( 'protng', 1 )
	      Call Write2Int( 0, 10 )
	      Call Write2Int( res, 10 )
	      Call WriteLn
	      RtIprote = RtIprote + 2**1

	END IF

	   addr = "16					! = 14(decimal)

	   res = IPROTE( addr )

	   IF ( res .ne. -2 ) THEN
	      Call MtFail( 'protng', 2 )
	      Call Write2Int( -2, 10 )
	      Call Write2Int( res, 10 )
	      Call WriteLn
	      RtIprote = RtIprote + 2**2

	END IF

	Call TestFail( RtIprote )

	Call CentLn( '--- Testing IPROTE Syslib Routine Completed ---\')
	Call WriteLn

	END IF

999	RETURN

	END

C------------------------------- RtIunprot ----------------------------------
C
C	RtIunprot --- Test program for the IUNPRO Syslib Routine.
C
C	Program      :
C	Author       : I. B. Sokari
C	Date	     : August 1988
C	Edited By    :
C	Date Edited  :
C	Language     : Fortran 77
C	Notes	     : Uses subroutines from both Syslib and RTNS libraries.
C
C=============================================================================

	Function  RtIunprot

C
C		Program Declarations
C
	Integer*4	RtIunprot

	Integer*2	val, Config, BFbit, j, addr, res

C
C		Program Initializations
C
	DATA		Config /"300/
	DATA		BFbit /"1/

	RtIunprot = 0

C
C		Main Program code
C

	Call CentLn( '--- Testing IUNPRO Syslib Routine ---\')
	Call CentLn( 'Unprotects the address of a two-word vector\')

C
C	Check the monitor before performing test. IUNPRO is only for
C	FB and XM monitors
C

	J = ISPY( Config )

	IF (( J .AND. BFbit ) .EQ. 0 ) THEN		! SJ Monitor; don't
							! perform test.
	   Call WriteLn
	   Call CentLn( '===============================================
     1===\')
	   Call CentLn( ' ?IUNPRO-I-Test not Performed \')
	   Call CentLn( ' IUNPRO is a special feature in FB/XM only \')
	   Call CentLn( '===============================================
     1===\')

	   GO TO 999

	ELSE						! Perform test

	   addr = "40					! = 32(decimal) 

	   res = IUNPRO( addr )

	   IF ( res .ne. 0 ) THEN
	      Call MtFail( 'unprot', 1 )
	      Call Write2Int( 0, 10 )
	      Call Write2Int( res, 10 )
	      Call WriteLn
	      RtIunprot = RtIunprot + 2**1

	END IF

	   addr = "16					! = 14(decimal)

	   res = IUNPRO( addr )

	   IF ( res .ne. -2 ) THEN
	      Call MtFail( 'unprot', 2 )
	      Call Write2Int( -2, 10 )
	      Call Write2Int( res, 10 )
	      Call WriteLn
	      RtIunprot = RtIunprot + 2**2

	END IF

	Call TestFail( RtIunprot )

	Call CentLn( '--- Testing IUNPRO Syslib Routine Completed ---\')
	Call WriteLn

	END IF

999	RETURN

	END