C*****************************************************************************
C
C	        Interface To Gidis Support Function Test Controller
C
C-----------------------------------------------------------------------------
C
C Program	: Interface to Gidis Test/ IGidis.For
C Editor/Author	: John Malcolmson
C Date		: July 1986
C Language	: Fortran 77
C Notes		: The program is chained to by the Libtst program.
C
C*****************************************************************************

	Program Igidis

		Integer*4	Report, Pnum
		Integer*4	Param(-9:18), rprt
		Character*14	dest
		Logical*2	appnd, Page
		Integer*2	Flag, dev, cblk(4), xxxzz, res
		Dimension       Spec(2)
		Equivalence	(VSpec, Param(-9))

		CALL RCHAIN( Flag, param(-7), 52 )

		IF (flag .eq. 0) THEN
			Call Irad50(3,'BIN',dev)
			IF (Idstat(dev,cblk) .eq. 1) THEN
				Call OpenOutput( 'TT:', .FALSE. )
				Call CLS
				Call WriteString('Please Run LibTst.Sav',0,0)
				Call WriteLn
				Call CloseOutput
				Goto 9999
			ELSE

				Open(unit=2,file='DAT:DGIDIS.DAT',Type='OLD',err=6)
				Read(2,5) Param(-7)
5				Format( 104A )
				Close(unit=2,Disp='DELETE')
				Call GetPage( Pnum )
				Call StsCon( Appnd, Page, Pnum, Param(-3) )
				CALL IRAD50(12, 'BINLIBTSTSAV', Spec )
				Call CloseOutput

				IF (IIAND(Ispy('300'O),2**12) .ne. 2**12) THEN

C					VSpec = Spec
C					Call Irad50(12, 'SY VBGCHNSAV', Spec)
C					Call Chain( Spec, param, 56 )
					Call Chain( Spec, param(-7), 52 )

				ELSE
		
					Call Chain( Spec, param(-7), 52 )
	
				END IF

				Goto 9999
6				Call Setcmd( 'RUN BIN:LIBTST' )
				Goto 9999

			END IF

		END IF

		IF (param(18) .ne. -1) THEN
			Do 10 xxxzz = 10, 22
				Call Write2Int( xxxzz, 5 )
				Call WriteOct( Iaddr(param(xxxzz)), 15 )
				Call WriteOct( param(xxxzz), 15 )
				Call WriteLn
10			Continue
			Stop '- Fatal Error : Corrputed Chain Data'
		END IF		

		Call ConSts(Param(-3),appnd,Page,Pnum)
		Call OpenOutput( param(-7), appnd )
		IF (page) Call SetPage('Gidis Support Functions\',pnum )

		res = Ispy( '300'O )
		IF (IIAND(res,2**12) .ne. 2**12) THEN
		    Call CenterString('-==============================-\')
		    Call WriteLn
		    Call CenterString('?GRAPHICS-I-CANNOT Perform The Tests in
     1 The Graphics Test Class!\')
		    Call WriteLn
		    Call WriteLn
		    Call CenterString('Gidis is only supported under XM!!\')
		    Call WriteLn
		    Call CenterString('-==============================-\')
		    Call WriteLn
		    Call WriteLn
		    Goto 999
		ELSE
		    res = Ispy( '370'O )
		    IF (IIAND(res, 2**13) .ne. 2**13) THEN
			Call CenterString('-=====================================-\')
			Call WriteLn
		        Call CenterString('?GRAPHICS-I-CANNOT Perform The
     1 Tests in The Graphics Test Class!\')
		        Call WriteLn
		        Call WriteLn
			Call CenterString('Gidis only runs on PRO series computers!!\')
			Call WriteLn
			Call CenterString('-=====================================-\')
			Call WriteLn
			Call WriteLn
			Goto 999
		    END IF
		END IF
			
		Open(unit=2,file='DAT:DGIDIS.DAT',Type='NEW')
		Write(2,15) Param(-7)
15		Format( 104A )
		Close(unit=2)
		Call SendMess(1)
		Call Setcmd('@BIN:UGIDIS.COM')
		Goto 9999

999		Call GetPage( Pnum )
		Call StsCon( Appnd, Page, Pnum, Param(-3) )
		CALL IRAD50(12, 'BINLIBTSTSAV', Spec )
		Call CloseOutput
	
		IF (IIAND(Ispy('300'O),2**12) .ne. 2**12) THEN

C			VSpec = Spec
C			Call Irad50(12, 'SY VBGCHNSAV', Spec)
C			Call Chain( Spec, param, 56 )
			Call Chain( Spec, param(-7), 52 )

		ELSE
		
			Call Chain( Spec, param(-7), 52 )

		END IF

9999	END

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