C-------------------------------- CheckC ------------------------------------)
C
C    This CheckC procedure makes sure that all of the condition needed for
C	test package to run are present on the system.  This includes disks,
C	devices, and auxilary programs.
C	
C	Error  - Indicates that something has not been verified.
C	Action - Contains a string to be exectued on program termination.
C============================================================================)

	Subroutine CheckC( Error, action )

		Logical*2	Error
		Character*65	OutStr
		Character*12	dvs
		Character*30	action, ac1		! was Char*16
		Byte		ac2(30)			! was ac(16)
		Integer*2	Dev, stts(4), Floaded, i, cnt, res, Envior
		Logical*2	Bitst2
		Equivalence	(ac1,ac2(1))

		Integer*2	Config, BFbit, XMbit

		DATA		Config /"300/
		DATA		BFbit /"1/
		DATA		XMbit /"10000/

c
c If SJ and no timer support, then inform operator
c
c		IF (Bitst2(Envior(),0) .eq. .FALSE.) THEN
c		    IF (Bitst2(Ispy('372'O),10) .eq. .FALSE.) THEN
c			Call Cls	
c			Call CenterString('Cannot run the test program\')
c			Call WriteLn
c			Call CenterString('The SJ monitor must have
c	1 timer support\')
c			Call WriteLn
c			Call Exit
c		    END IF
c		END IF
c		
		Error = .FALSE.
c
c Check for existance of BIN device
c
		CALL IRAD50( 3, 'BIN', Dev )
		OutStr ='Please assign BIN: to the syslib test directory.\'
		IF (IdStat( Dev, stts ) .eq. 1) THEN
			Call OpenOutput( 'TT:', .False. )
			Call Cls
			Call CenterString( '+-----------------------+\' )
			Call WriteLn
			Call CenterString( '+---  C A U T I O N  ---+\' )
			Call WriteLn
			Call CenterString( '+-----------------------+\' )
			Call WriteLn
			Call WriteLn
			Call CenterString( 'Logical BIN: Not Defined!\' )
			Call WriteLn
			Call CenterString( OutStr )
			Call WriteLn
			Call WriteLn
			Action = 'No Assignment  '
			Call WriteString('Assuming DK:, Enter correct
	1 device: \',0,0)
			Read( 3, 5, err=7,end=7 ) dvs
5			Format( A10 )
			Call UpperCase( dvs, 4 )
			IF (dvs(1:3) .eq. '   ') dvs = 'DK:'
			action       = ' '
			action(1:7)  = 'Assign '
			action(8:10) = dvs(1:3)
			action(11:)  = ' BIN:'
7			Call Scopy( action, action, 30 )	! was 16
			Call Cls
			Call WriteString( action, 0, 0 )
			Call WriteLn
			Error = .TRUE.
			RETURN
		END IF
		OutStr = ' '
c
c  Check for NL Loaded
c		
		cnt = 0
		Call Irad50( 2, 'NL', dev )
		Call Idstat( dev, stts )
		IF (stts(3) .eq. 0) cnt = 4

C
C  Check monitor and inform user of the monitor under which 
C               the SYSLIB Package is tested.
C

		J = ISPY(Config)

		IF (( J .AND. BFbit ) .EQ. 0 ) THEN		! SJ Monitor

		  Call WriteLn
		  Call CenterString( 'RUNNING THE SYSLIB TEST PACKAGE UNDER
     1 THE  SJ  MONITOR \')
		  Call WriteLn
		  Call CenterString( '=====================================
     1================= \')
		  Call WriteLn

		ELSE

		    IF (( J .AND. XMbit ) .NE. 0 ) THEN		! XM Monitor

		      Call WriteLn
		      Call CenterString( 'RUNNING THE SYSLIB TEST PACKAGE
     1 UNDER THE  XM  MONITOR \')
		      Call WriteLn
		      Call CenterString( '===============================
     1======================= \')
		      Call WriteLn

		    ELSE					! FB Monitor

		      Call WriteLn
		      Call CenterString(' RUNNING THE SYSLIB TEST PACKAGE
     1 UNDER THE  FB  MONITOR \')
		      Call WriteLn
		      Call CenterString( '===============================
     1======================= \')
		  Call WriteLn

		    END IF

		  END IF
c
c  If FB/XM
c     
c	
	    	IF (IIAND(Envior(),1) .ne. 0) THEN		! FB/XM?
			i = Floaded()			! PRTNR working?
			IF ((i.eq.0).and.(cnt.eq.0)) Return	! Return if so
			IF (i .ne. 0) cnt = i			! cmd file no.
			IF (IIAND(Envior(),2) .eq. 2) THEN	! SL loaded?
c				ac1     = '@bin:libx'
c				ac1     = '@bin:libx'
c				ac2(10) = '0' + cnt
c				ac2(11) = 0
c				action  = ac1
				action = 'FRUN the PRTNR program (1)'
			ELSE
c				ac1     = '@bin:libf'
c				ac1     = '@bin:libf'
c				ac2(10) = '0' + cnt
c				ac2(11) = 0
c				action  = ac1
				action = 'FRUN the PRTNR program (2)'
			END IF
		ELSE
			IF (cnt .eq. 4) THEN
c				action = '@bin:libx4'
				action = 'LOAD NL'
			ELSE
				Return
			END IF
 		END IF

1000		Error    = .TRUE.
		Call Scopy( action, action, 30 )		! was 16
		RETURN

	END

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

C-------------------------------- SUMMARY -----------------------------------)
C
C    The Summary procedure accepts the current chain area and the string of
C	class labels.  It then from this information builds a chart indicating
C	which classes failed and how badly they failed.
C
C	Status	- The chain area
C	Strn	- The Class label string
C	Len	- How many classes are valid
C
C============================================================================)

	Subroutine Summary( status, strn, len )

		Integer*4 	status(-9:18)
		Character*16	strn( 17 ), disp
		Integer*4	q, x, k
		Integer*4	count1, count2, Pnum
		Character*40	dsp
		Character*14    dest
		Character*80    st
		Logical*2	appnd, pagng
C
		st = ' '
		dsp = ' '
		dest = ' '
		disp = ' '
C

		Call CloseOutput
		Call ConSts( Status(-3), appnd, pagng, Pnum )
		Call OpenOutput( status(-7), appnd )		
		If (pagng) Call SetPage( 'Syslib Test Summary\', Pnum )

		dsp = '########################################'
		st  = '+==== Syslib Test Class Participation Summary ====+\'
		Call CenterString( st )
		Call WriteLn

		x = 0
		DO 10 k = 1, len
			q = Status( k )
			IF (q .ge. 0) THEN
				disp = Strn(k)(1:15)
				Call SetTrm( disp, 16 )
				Call CenterString( disp )
				Call WriteLn
				x = x + q
			END IF
10		Continue

		st = '+==== End of Syslib Participation Summary ====+\'
		Call CenterString( st )
		Call WriteLn
		Call WriteLn
		st = '+==== Syslib Test Class Failure Report Summary ====+\'
		Call CenterString( st )
		Call WriteLn

		IF (x .eq. 0) THEN

			st = '<--- There were no errors encountered --->\'
			Call CenterString( st )
			Call WriteLn

		ELSE

			DO 20 k = 1, len
		
			    IF (status(k) .gt. 0) THEN

				Count1 = Status(k) / 1000
				Count2 = Status(k) - ( Count1 * 1000 )

				Call WriteString( strn(k), 0, 15 )
				Call WriteString(' - Routines failed : \',0,0)
				Call WriteInt( Count2, 3 )
				Call WriteString( '. \', 0, 0 )
				Count1 = Count1 / 5
				IF (count1 .ge. 35) Count1 = 35
				Call WriteString( dsp, 0, Count1+1 )
				IF (count1 .eq. 35) Call WriteString('>\',0,1)
				Call WriteLn

			    END IF

20			Continue

		END IF

		st = '+==== End of Syslib Failure Report Summary ====+\'
		Call CenterString( st )
		Call WriteLn

		Call CloseOutput
		Call OpenOutput( 'TT:', .FALSE. )
		Return

	END

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


C--------------------------------- Trans ------------------------------------)

	Subroutine Trans( dest, value )

		Character*14	dest
		BYTE		value(120)

		DO 10 i = 1, 14
			value(i) = IChar( dest(i:i) )
10		Continue

	END

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

C-------------------------------- Startup -----------------------------------)
C
C    The Startup routine is basically the main menu of the program.  It
C	accepts the chain area as input and sets up the instructions in
C	it for the test controllers.
C
C	Init	- The chain area.
C
C============================================================================)

	Subroutine Startup( Init )

		Integer*4	Init(-9:18)
		Integer*2       ResF, ResS, Slen, i, j, k
		Character*14    Dest
		Character*40    Inp, Strt, Fini, Switch, prmpt
		Character*130   comm
		Character*81	line, text, A, B, C
		Logical*2	Appnd, Pagng

		Call Scopy('    #EXIT#ALL #ARIT#CHAR#CHAN#DATA#DEVI#',A)
C			     0    1    2    3    4    5    6    7
		Call Scopy('FILE#GRAP#MISC#MULT#RADI#RT-1#TIME#    #',B)
C			     8    9    10   11   12   13   14   15 
		Call Scopy('    #    #DATE#USER#    #SUMM#HELP#    #',C)
C			     16   17   18   19   20   21   22   23
		Call Concat( A,    B, comm )
		Call Concat( comm, C, comm )

1		Call Cls
5		Call BoldCenter( '-------------------------\' )
		Call Writeln
		Call BoldCenter(    'Syslib Test Program\' )
		Call WriteLn
		Call BoldCenter( '-------------------------\' )
		Call Writeln
		Call Repeat( '=', line, 80 )
		Call WriteString( line, 0, 0 )
		Call WriteLn
		Call WriteLn
		Call WriteString( '< Exit >       \', 08, 15 )
		Call WriteString( '< Help >       \', 03, 15 )  
		Call WriteString( '< Summary >    \', 03, 15 )
		Call WriteString( '< All >        \', 03, 15 )
		Call WriteLn
		Call WriteString( 'Arithmetic     \', 08, 15 )
		Call WriteString( 'Character Strng\', 03, 15 )
		Call WriteString( 'Channel-Orientd\', 03, 15 )
		Call WriteString( 'Data Transfer  \', 03, 15 )
		Call WriteLn
		Call WriteString( 'Date Support   \', 08, 15 ) 	!Added 8/17/88
		Call WriteString( 'Device&File Spc\', 03, 15 )
		Call WriteString( 'File-Oriented  \', 03, 15 )
		Call WriteString( 'Graphics Supprt\', 03, 15 )
		Call WriteLn 
		Call WriteString( 'Miscellaneous  \', 08, 15 )
		Call WriteString( 'Multiterminal  \', 03, 15 )
		Call WriteString( 'Radix-50 Supprt\', 03, 15 )
		Call WriteString( 'RT-11 Services \', 03, 15 )
		Call WriteLn
		Call WriteString( 'Timer Support  \', 08, 15 )
		Call WriteString( 'User Intractive\', 03, 15 )
		Call WriteLn
		Call WriteLn
		Call WriteLn
		Call Concat( 'Enter test to perform : ', "200, prmpt )

		Call GtLin( Inp, Prmpt )

		Appnd    = .FALSE.
		Pagng    = .FALSE.
		Init(-2) = 0
		Init(-1) = 0
		Init(0)  = 0

		IF (Ichar(inp(1:1)) .eq. 26) Goto 999		
		Call Uppercase( Inp, 39 )

		j        = Index(Inp,'=')
		i        = Index(Inp,'/')

		If ((i .gt. 0 ).and.(i .lt. j)) THEN

			Switch = Inp(i+1:j-1)

			DO 11 k=1,2
				IF (Switch(1:1) .eq. 'A') Appnd = .TRUE.
				IF (Switch(1:1) .eq. 'P') Pagng = .TRUE.
				i = Index(Switch,'/')
				If (i .gt. 0) Switch = Switch(i+1:)
11			Continue

			i = Index(Inp,'/')
			Inp(i:) = Inp(j:)

		END IF

		i = Index( Inp, '=' )

		If (i .gt. 0 ) THEN

			dest(1:14) = Inp(1:i-1)
			Inp(1:)    = Inp(i+1:)

			DO 20 i = 1, Slen( Inp )
				IF (Inp(1:1) .eq. ' ') THEN
					Inp(1:) = Inp(2:)
				END IF
20			Continue

25			i = Index( Dest, ':' )

			IF (i .eq. 0) THEN
				dest(5:)  = dest(1:)
				dest(1:4) = 'BIN:'
				Goto 25
			END IF

			IF (i .eq. 0) i = Index( Dest, ':' )

			IF (dest(i+1:i+1) .ne. ' ') THEN
				Appnd = .Not. Appnd
				Pagng = .Not. Pagng
			END IF

			IF ((LLE(Dest(1:3),'TT:')).and.(LGE(Dest(1:3),'TT:')))Init(-2)=1

		ELSE

			dest     = 'TT:'
			Init(-2) = 1

		END IF

		i = Index(Inp,' ')

		IF ( i .gt. 0 ) THEN

			strt = Inp(1:i-1)
			fini = Inp(i+1:)
			DO 30 i = 1, Slen( fini )
				IF (Fini(1:1) .eq. ' ') THEN
					Fini(1:) = Fini(2:)
				END IF
30			Continue

		ELSE

			strt(1:5) = Inp(1:5)
			Fini(1:5) = '     '

		END IF

		IF (strt(2:2) .eq. 'L') strt(4:4) = ' '
		IF (fini(2:2) .eq. 'L') fini(4:4) = ' '

		strt(5:5) = '#'
		fini(5:5) = '#'

		ResS = INDEX( Comm, strt(1:5) ) / 5 - 1
		ResF = INDEX( Comm, Fini(1:5) ) / 5 - 1

c
c		write(5,111) init(0)
c111	 format(' Current class is: ',I4)
c		write(5,112) ResS, ResF
c112	 format(' ResS = ',I2,'ResF = ',I2)
c
		Call Cls

		IF (ResS .lt. 0)                 Goto 5
		IF (ResF .eq. 0)                 Goto 5
		IF (ResF .eq. 20)                Goto 5
		IF (ResF .eq. 21)                Goto 5
		IF (ResS .eq. ResF)              ResF = -1
		IF (ResS .eq. 1)                 ResF = 0
		IF (ResS .eq. 20)                ResF = -1
		IF (ResS .eq. 21)                ResF = -1
		IF (ResS .gt. 1)                 ResS = ResS - 1
		IF (ResF .gt. 1)                 ResF = ResF - 1
		IF ((ResF.lt.0).and.(ResS.ne.0)) ResS = -ResS
		IF (ResF .eq. 1)                 ResF = 0

		Init(0)  = ResS
		Init(-1) = ResF

c
c		write(5,113) init(-2)
c113	 format(' Starting class number =',I4)
c

		IF (Init(-2) .eq. 1) THEN
			Init(-2) =  ABS( ResS )
		ELSE
			Init(-2) = -ABS( ResS )
		END IF
	
		IF (ABS(ResS) .eq. 20) Init(-2) = -ABS( ResS )

		Call StsCon( Appnd, Pagng, 0, Init(-3) )

		Call Trans( dest, Init(-7) )
		
999	END

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

C---------------------------------- HELP ------------------------------------)
C
C    The Help routine just displays a basic overview of the command structure
C
C============================================================================)

	Subroutine Help

		Character*80	st		

		Call Cls
		Call BoldCenter( '+-------------------------+ \' )
		Call Writeln
		Call BoldCenter(           'H E L P \' )
		Call WriteLn
		Call BoldCenter( '+-------------------------+ \' )
		Call Writeln
		Call Repeat( '=', line, 80 )
		Call WriteString( line, 0, 0 )
		Call WriteLn
		Call WriteLn
		st = '[Dev:[Filename][/Toggles] = ] {ClassName|All} [ClassName|All]\'
		Call CenterString( st )
		Call WriteLn
		Call WriteLn
		st = 'The Toggles are by default on for files and off for devices:\'
		Call WriteString( st, 0, 0 )
		Call WriteLn
		st = '/Append - Causes output (to/not to) be append to one file.\'
		Call CenterString( st )
		Call WriteLn
		st = '/Paging - Causes output (to/not to) be in numbered pages. \'
		Call CenterString( st )
		Call WriteLn
		Call WriteLn
		st = 'Examples:\'
		Call WriteString( st, 0, 0 )
		Call WriteLn
		
		st = 'All                       - To screen with toggles off.   \'
		Call CenterString( st )
		Call WriteLn
		st = 'Channel Radix             - To screen with toggles off.   \'
		Call CenterString( st )
		Call WriteLn
		st = 'File.out = All            - To File with paging+append on.\'
		Call CenterString( st )
		Call WriteLn
		st = 'File.out/page = File All  - To File with paging off.      \'
		Call CenterString( st )
		Call WriteLn
		st = 'LP:/Page = Arith Channel  - To Printer with paging on.    \'
		Call CenterString( st )
		Call WriteLn
		Call WriteLn
		Call Query( 'Press <Return> to continue. \' )

	END

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