C*****************************************************************************
C
C                   Test of Miscellaneous Syslib Routines.
C	 		     Importable Functions
C
C-----------------------------------------------------------------------------
C
C Program	: Miscellaneous/ Misc.For
C Author	: John Malcolmson
C Date		: June 1986
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	IGETSP, INTSET
C
C*****************************************************************************


C--------------------------------- IGETSP ------------------------------------

	Function TstGetsp

		Integer*4	TstGetsp
		Integer*2	res, IgetSp, addr, i, val
		
		Call CenterString( '--- Testing IGETSP ---\' )
		Call WriteLn
		Call CenterString(
	1	'Gets the address and size of some free space\')
		Call WriteLn
		TstGetsp = 0

		res = Igetsp( 2**14, 2**14, addr )
		IF (res .ne. -1) THEN
			Call MtFail( 'M-Oflo', 1 )
			Call Write2Int( -1,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstGetsp = TstGetsp + 2**1
		END IF

		res = Igetsp( 10, 30, addr )
		IF (res .lt. 10) THEN
			Call Mtfail( 'alloct', 2 )
			Call Write2Int( 5,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstGetsp = TstGetsp + 2**2
		END IF
		IF (res .gt. 30) THEN
			Call Mtfail( 'alloct', 3 )
			Call Write2Int( 30,  10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstGetsp = TstGetsp + 2**3
		END IF
		
		IF (res .lt. 1) Goto 50
		DO 10 i = 0, res-1
			Call Ipoke( addr+(2*i), 0 )
			val = Ipeek( addr+(2*i) )
			IF (val .ne. 0) THEN
				Call IrsltFail( 4+i )
				Call Write2Int( addr+(2*i), 06 )
				Call Write2Int( 0,          10 )
				Call Write2Int( val,        10 )
			END IF
10		Continue 

50		Call TestFail( TstGetsp )

		Call CenterString( '--- Testing IGETSP completed ---\' )
		Call WriteLn
		Call WriteLn

	END

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

C---------------------------------- INTSET -----------------------------------

	Function TstIntset

		External	IntHand, Trgiot

		Integer*4	TstIntset
		Integer*2	res, IntSet, Envior
		Real*8		value
		Logical*2	RTEM, SJ

		Call CenterString( '--- Testing INTSET ---\' )
		Call WriteLn
		Call CenterString( 'Establishes a FORTRAN interupt handler\')
		Call WriteLn
		TstIntset = 0

cc		res = Ispy( '372'O ) / 2**3
cc		IF (res .ne. (res/2)*2) Goto 999
		IF (RTEM()) Goto 999
		
		IF (SJ()) THEN
		    Call CenterString('-- Not Supported under SJ --\')
		    Call WriteLn
		    Goto 999
		END IF

			
		res = IntSet( "255, 6, 7, IntHand )
		IF (res .ne. 1) THEN
			Call MtFail( 'vctchk', 1 )
			Call Write2Int( 1,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIntset = TstIntset + 2**1
		END IF

		Call Isleep( 00,00,02,00 )
		res = IntSet( "20, 6, 7, IntHand )
		Call TrgIot
		Call Isleep( 00,00,02,00 )
		IF (res .ne. 0) THEN
			Call MtFail( 'normal', 2 )
			Call Write2Int( 0,   10 )
			Call Write2Int( res, 10 )
			Call WriteLn
			TstIntset = TstIntset + 2**2
		END IF

999		Call TestFail( TstIntset )

		Call CenterString( '--- Testing INTSET completed ---\' )
		Call WriteLn
		Call WriteLn

	END

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

C=================================== IntHand =================================

	Subroutine IntHand( idn )

		Integer*2	Idn, qrs

		qrs = idn
		IF (qrs .ne. 7) THEN
			Call MtFail( 'Bad-Id', 10 )
			Call Write2Int( 7,   10 )
			Call Write2Int( qrs, 10 )
			Call WriteLn
		END IF

		Call CenterString('++ Entered the interupt handler ++\' )
		Call WriteLn
	END

C=============================================================================