Google
 

Trailing-Edge - PDP-10 Archives - dec-10-omona-u-mc9 - scdset.for
There are 9 other files named scdset.for in the archive. Click here to see a list.
				
*REVISION HISTORY:
*	VERSION 1: MARCH 31 1975 BY MICHAEL TIGHE
*
*EDIT NUMBER	REASON
*-----------	------
*  	1	QAR #3555: POSSIBLE OVERFLOW IN FUNCTION 7
*	2	IF ACCT(14) IS NEGATIVE, BYTE CALCULATION AT
*		LINE  (LABEL 100)+2 FAILS.  (18848)
*	3	BATCH JOBS DON'T GET SET INTO CORRECT
*		SCHED CLASS,  SUBR FIXJOB, LINE 41 USES DECIMAL
*		INTO GETTAB TBL WHERE OCTAL NEEDED

*	VERSION 2:  D. OXLEY 13 JUL 76

* 	4	REPLACE NUMERIC FUNCTION SELECTION WITH 
*		COMMANDS
*

	PROGRAM SCDSET
*
*		THIS PROGRAM IS A SIMPLE COMMAND LOOP THAT ALLOWS THE
*		USER (ASSUMING HE HAS THE PRIVILEGES) TO EXECUTE THE
*		SCHED. UUO.  THERE IS ONE SUBROUTINE FOR EACH SCHED.
*		FUNCTION TO SET UP THE ARRAY D.  A IS SET UP BY THE
*		MAIN PROGRAM.  THE SUBROUTINE THAT EXECUTES THE UUO
*		IS A MACRO PROGRAM CALLED SCDEXE.  IT TAKES THE COMMON
*		DATA AREA FOR ITS ARGUMENT BLOCKS.
*
*		THERE ARE OTHER SUBROUTINES THAT DO USEFUL WORK FOR
*		THE SYSTEM ADMINISTRATOR.
*			MAKMAP GENERATES A SCDMAP.SYS FILE.
*			FIXJOB PUTS IT ON SYS AND UPDATES THE SCHEDULER
*				CLASS FOR ALL LOGGED IN JOBS
*			MOVSCD MOVES A SCDMAP.SYS FILE TO THE SYS AREA
*
*(IT IS STRONGLY SUGGESTED THAT THIS PROGRAM BE RUN IN HPQ)
*
	IMPLICIT INTEGER (A-Z)
*
	PARAMETER FUNLEN=20		!NUMBER CHARS PER FUN
	PARAMETER NOFUNS=10		!NUMBER FUNCTIONS
	PARAMETER MINCHR=1		!MIN ABBREVICTION
	PARAMETER CMDLEN=20		!NUMBER CHARS PER COMMAND
	PARAMETER NOCMDS=7
	PARAMETER FL=4			!FUNLEN+4/5
	PARAMETER CL=4			!CMDLEN+4/5
*
	DIMENSION CLIST(FL,NOFUNS)
	DIMENSION CLISTD(3)
	DIMENSION CLISTA(FUNLEN,NOFUNS)
	DIMENSION DLIST(CL,NOCMDS)
	DIMENSION DLISTD(3)
	DIMENSION DLISTA(CMDLEN,NOCMDS)
*
	DIMENSION SRCSTR(80)
*
	COMMON A,B,D,W,Z,HCL
	DIMENSION D(0/128)
*
*		A = LH OF AC ARGUMENT FOR SCHED. UUO
*		B = 0 IF UUO WON, ERROR NUMBER OTHERWISE
*		D = THE ARRAY THAT HOLDS THE TABLE FOR THE UUO
*		W = CURRENT STATE OF WRITING (=1) OR READING (=0)
*		Z = JOBMAX OF THE SYSTEM. D SHOULD BE DIMENSIONED
*			LARGER THAN JOBMAX OR HIGHEST CLASS NUMBER
*		HCL = HIGHEST CLASS NUMBER FOR THE SYSTEM CURRENTLY
*			BEING RUN.
*
*	THE FOLLOWING FUNCTIONS ARE INVOKED BY ENTERING
*	THE READ OR SET COMMAND FOLLOWED BY THE DESIRED 
*	FUNCTION (SEPARATED BY A COMMA).
*
	DATA (CLIST(I,1),I=1,FL)/'MTS INTERVAL       '/
	DATA (CLIST(I,2),I=1,FL)/'MCU INTERVAL        '/
	DATA (CLIST(I,3),I=1,FL)/'CLASS QUOTAS        '/
	DATA (CLIST(I,4),I=1,FL)/'TIMESLICE           '/
	DATA (CLIST(I,5),I=1,FL)/'CHANNEL UTILIZATION '/
	DATA (CLIST(I,6),I=1,FL)/'JOB CLASS           '/
	DATA (CLIST(I,7),I=1,FL)/'PROT0               '/
	DATA (CLIST(I,8),I=1,FL)/'RUNTIME BY CLASS    '/
	DATA (CLIST(I,9),I=1,FL)/'EXPONENTIAL FACTOR  '/
	DATA (CLIST(I,10),I=1,FL)/'PROT                '/
	DATA (CLISTD(I),I=1,3)/FUNLEN,NOFUNS,MINCHR/
*
	DATA (DLIST(I,1),I=1,CL)/'HELP               '/
	DATA (DLIST(I,2),I=1,CL)/'EXIT               '/
	DATA (DLIST(I,3),I=1,CL)/'UPDATE JOBS        '/
	DATA (DLIST(I,4),I=1,CL)/'EDIT               '/
	DATA (DLIST(I,5),I=1,CL)/'COPY               '/
	DATA (DLIST(I,6),I=1,CL)/'READ               '/
	DATA (DLIST(I,7),I=1,CL)/'SET                '/
	DATA (DLISTD(I),I=1,3)/CMDLEN,NOCMDS,MINCHR/
*
	DATA BLANK,COMMA/' ',',    '/
*
	DO 10 I=1,NOFUNS
	  DECODE (FUNLEN,95,CLIST(1,I))(CLISTA(J,I),J=1,FUNLEN)
   10	CONTINUE
	DO 15 I=1,NOCMDS
	  DECODE (CMDLEN,95,DLIST(1,I))(DLISTA(J,I),J=1,CMDLEN)
   15	CONTINUE
*
	A = "15000011			!GETTAB FOR # OF JOBS
	CALL TABGET
	Z = 128				!A DEFAULT VALUE
	IF (B .EQ. 0)  Z = (A .AND. "777777) - 1
*			THAT SETS Z TO SYSTEM JOBMAX
	A = "117000011			!GETTAB FOR # OF SCD CLASSES
	CALL TABGET
	HCL = 32			!A DEFAULT VALUE
	IF (B .EQ. 0) HCL = A
	HCL1 = HCL			!FOR PRINTOUT
	HCL = HCL - 1			!HIGHEST NUM (COUNT UP FROM 0)
*			THAT SETS HCL TO SYSTEM CONFIG.
	WRITE (5, 99) Z, HCL1
  100	WRITE (5, 98)
	READ (5,97) (SRCSTR(I),I=1,60)
*
*
	DO 20 I=1,60
	  IF (SRCSTR(I) .NE. BLANK) GOTO 30
   20	CONTINUE
	GOTO 500
   30	CMD = STRMCH(DLISTA(1,1),DLISTD(1),SRCSTR(I))
	DO 40 I=I,60
	  IF (SRCSTR(I) .EQ. COMMA) GOTO 50
   40	CONTINUE
	FUN=0
	GOTO 80
   50	I=I+1
	DO 60 I=I,60
	IF (SRCSTR(I) .NE. BLANK) GOTO 70
   60	CONTINUE
	GOTO 500
   70	FUN = STRMCH(CLISTA(1,1),CLISTD(1),SRCSTR(I))-1
*
   80	GOTO (500,200,205,210,215,220,225,230), CMD+1
  200	WRITE (5,88) ((DLIST(I,J),I=1,CL),J=1,NOCMDS),
     1      ((CLIST(I,J),I=1,FL),J=1,NOFUNS)
	GOTO 400
  205	STOP;          GOTO 400
  210	CALL FIXJOB;   GOTO 400
  215	CALL MAKMAP;   GOTO 400
  220	CALL MOVSCD;   GOTO 400
  225	W=0;           GOTO 250
  230	W=1
  250	A = FUN .OR. (W*"400000)
*
	GOTO (500,300,305,310,315,320,325,330,335,340,345), FUN+2
  300	CALL FUN0;   GOTO 400
  305	CALL FUN1;   GOTO 400
  310	CALL FUN2;   GOTO 400
  315	CALL FUN3;   GOTO 400
  320	CALL FUN4;   GOTO 400
  325	CALL FUN5;   GOTO 400
  330	CALL FUN6;   GOTO 400
  335	CALL FUN7;   GOTO 400
  340	CALL FUN8;   GOTO 400
  345	CALL FUN9;   GOTO 400
  500	WRITE (5,96)
  400	GOTO 100
*
*
   88	FORMAT (/, X, 'COMMANDS:',
     F	/, 4X, 4A5,'- TYPE HELP TEXT',
     E	/, 4X, 4A5,'- EXIT',
     D	/, 4X, 4A5,'- UPDATE ALL LOGGED IN JOBS TO THE RIGHT CLASS',
     C	/, 4X, 4A5,'- MANIPULATE A SCDMAP.SYS FILE',
     B	/, 4X, 4A5,'- MOVE A SCDMAP.SYS FILE TO THE SYS AREA',
     A	/, 4X, 4A5,'- READ SCHEDULING VARIABLE',
     A	/, 4X, 4A5,'- SET SCHEDULING VARIABLE',
     1  //, X, 'READ/SET FUNCTIONS:'
     1  /, 4X,  'TYPE READ OR SET FOLLOWED BY A COMMA AND A',
     1  /, 4X,  'FUNCTION FROM THE FOLLOWING LIST',
     A	/, 4X, 4A5,'- MEDIUM TERM SCHEDULING INTERVAL',
     1	/, 4X, 4A5,'- MIN CORE USE FUNCTION EVALUATION',
     1  ' INTERVAL',
     2	/, 4X, 4A5,'- SYSTEM USAGE QUOTA FOR A SCHEDULER CLASS',
     3	/, 4X, 4A5,'- TIME SLICE FOR EITHER RUN QUEUE',
     4	/, 4X, 4A5,'- SWAPPING CHANNEL UTILIZATION PERCENTAGE',
     5	/, 4X, 4A5,'- SCHEDULER CLASS FOR SPECIFIC JOBS',
     6	/, 4X, 4A5,'- PROT0 (CONSTANT ADDED TO THE MCU)',
     7	/, 4X, 4A5,'-  RUNTIME FOR EACH CLASS SINCE SYS STARTUP',
     8	/, 4X, 4A5,'- EXPONENTIAL AVERAGING FACTOR',
     9	/, 4X, 4A5,'- PROT (MCU MULTIPLIER)')
   95	FORMAT (80A1)
   96	FORMAT ('  %INPUT ERROR - REENTER OR TYPE HELP')
   97	FORMAT(80A1)
   98	FORMAT (///, X, '(TOP LEVEL)', /, X,
     1	'WHICH FUNCTION DO YOU WANT ', $)
   99	FORMAT(1X,'SYSTEM ADMINISTRATOR SCHEDULER SETTING PROGRAM',
     A	',  VERSION 1.',/, X, 'SYSTEM CONFIGURATION IS FOR ', I4,
     1	 ' JOBS AND ', I2, ' SCHEDULER CLASSES.', //,
     2	X, 'SUGGESTION: RUN IN HPQ',/,
     3	X, 'TYPE HELP FOR HELP')
	END
	SUBROUTINE ERRCON
*		HANDLES ERROR REPORTING
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z
	DIMENSION D(0/128)
	IF (B .EQ. 0 ) GOTO 110
	WRITE (5, 83)
	IF ((B .LT. 0) .OR. (B .GT. 9))  GOTO 100
	GOTO (1,2,3,4,5,6,7,8,9) B
    1	WRITE(5,91); GOTO 300
    2	WRITE(5,92); GOTO 300
    3	WRITE(5,93); GOTO 300
    4	WRITE(5,94); GOTO 300
    5	WRITE(5,95); GOTO 300
    6	WRITE(5,96); GOTO 300
    7	WRITE(5,97); GOTO 300
    8	WRITE(5,98); GOTO 300
    9	WRITE(5,99); GOTO 300
  100	WRITE(5,81) B; GOTO 300
  110	WRITE(5,80); GOTO 300
  300	RETURN
   80	FORMAT(//, X, 'DONE', /)
   81	FORMAT(X, 'ERROR NUMBER:' ,I8, /)
   83	FORMAT(X, 'ERROR: ', $)
   91	FORMAT(X, 'ADDRESS CHECK ERROR',/)
   92	FORMAT(X, 'BAD FUNCTION NUMBER',/)
   93	FORMAT(X, 'BAD JOB NUMBER',/)
   94	FORMAT(X, 'NO PRIVILEGES',/)
   95	FORMAT(X, 'BAD CLASS NUMBER',/)
   96	FORMAT(X, 'BAD QUEUE NUMBER',/)
   97	FORMAT(X, 'BAD CHANNEL NUMBER',/)
   98	FORMAT(X, 'BAD EXPONENTIAL FACTOR (RANGE: 0-10000.)',/)
   99	FORMAT(X, 'ATTEMPT TO MANUALLY SET PROT (MCU MULTIPLIER)',/)
	END

	SUBROUTINE FUN0
	IMPLICIT INTEGER (A-Z)
	COMMON A,B,D,W,Z
	DIMENSION D(0/128)
*
*		READS OR SETS THE MEDIUM TERM SCHEDULING INTERVAL
*		(THE INTERVAL AT WHICH RESOURCE QUOTA ENFORCEMENTS ARE
*		MADE--LUMPINESS)  THE MEASUREMENT IS IN JIFFIES.
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
  101	WRITE (5, 99)
   99	FORMAT(X, 'NEW VALUE FOR THE MED. TERM SCHED. INTERVAL:',
     1	' (IN JIFFIES) ', $)
	READ (5, *) D (0)
	IF ( D(0) .LT. 0) RETURN
	IF ( D(0) .GT. 10000) RETURN
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (5, 97) D(0)
   97	FORMAT (X, 'MED TERM SCHED INTERVAL NOW =', I8, ' JIFFIES')
	RETURN
	END

	SUBROUTINE FUN1
*
*		READ/SET MINIMUM CORE USE QUOTA ENFORCEMENT INTERVAL
*		MEASUREMENT IS IN SECONDS
*
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z
	DIMENSION D(0/128)
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
	WRITE(5, 99)
   99	FORMAT (X, 'NEW VALUE FOR THE MIN CORE USE INTERVAL',
     1	' (IN SECONDS) ', $)
	READ (5, *) D(0)
	IF (( D(0) .LT. 0) .OR. ( D(0) .GT. 10000)) RETURN
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (5, 97) D(0)
   97	FORMAT (X, 'MIN CORE USEAGE INTERVAL IS:',I8, ' SECONDS')
	RETURN
	END

	SUBROUTINE FUN2
*
*		READ/SET CLASS QUOTA'S
*		(IE THE PERCENTAGE OF THE SYS A CLASS CAN HAVE)
*
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL
	DIMENSION D(0/128)
	GOTO (100,101) W+1
*
  100	WRITE (5, 99) HCL
   99	FORMAT (X, 'HIGHEST CLASS (0-', I2, ') ', $)
	READ (5, *) D(0)
	IF ( D(0) .EQ. -1) RETURN
	IF ( D(0) .LT. 0) GOTO 100
	IF ( D(0) .GT. HCL) GOTO 100
	D(0) = D(0) + 1
	DO 110 I=1, D(0)
  110	D(I) = 0
	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	DO 120 I=1,D(0)
	I1=I-1
	F = ' ' 
	IF ( D(I) .GE. 0) GOTO 120
	F = 'F'
	D(I) = D(I) .AND. "377777777777
  120	WRITE (5, 97) I1, D(I), F
   97	FORMAT (X, 'CLASS:',I2,'  PERCENTAGE OF SYSTEM:',I3, A1)
	RETURN
*
  101	D(0) = 1
	WRITE (5, 96) HCL
   96	FORMAT (X, 'GIVE CLASS NUMBER (0-', I2,
     1	 ') AND THEN THE PERCENTAGE OF RESOURCES (0-100) ',
     2	/, 5X, '(-1 TO EXIT)')
  150	WRITE (5, 95)
   95	FORMAT (/,X,'CLASS: ', $)
	READ (5, *) CVAL
	IF (CVAL .EQ. -1) RETURN
	IF (CVAL .LT. 0) GOTO 150
	IF (CVAL .GT. HCL) GOTO 150
  155	WRITE (5, 93)
   93	FORMAT (X, 'PERCENTAGE OF SYSTEM (0-100): ', $)
	READ (5, *) PVAL
	IF (PVAL .EQ. -1) RETURN
	IF (PVAL .LT. 0) GOTO 155
	IF (PVAL .GT. 100) GOTO 155
	WRITE (5, 92)
   92	FORMAT (X, 'FIXED QUOTA? (1=YES) ', $)
	READ (5, *) FVAL
	IF (FVAL .EQ. -1) RETURN
	IF (FVAL .NE. 1) FVAL = 0
	D(1) = FVAL*"400000000000 .OR. CVAL*"1000000 .OR. PVAL
	CALL SCDEXE
	CALL ERRCON
	GOTO 150
	END

	SUBROUTINE FUN3
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL
	DIMENSION D(0/128)
*
*		READ/SET TIME SLICES FOR THE TWO QUEUES.
*		MEASURED IN MILLISECONDS
*
	IF (W .EQ. 0) GOTO 200
  100	WRITE (5, 99)
   99	FORMAT (X, 'CHANGE TIME SLICE OF WHICH PQ (1-2) ', $)
	READ (5, *) PVAL
	IF (PVAL .EQ. -1) RETURN
	IF ( PVAL .LT. 1) GOTO 100
	IF ( PVAL .GT. 2) GOTO 100
  105	WRITE (5, 98) PVAL
   98	FORMAT (X, 'TIME SLICE FOR PQ', I1, ' (IN MILLISECONDS) ', $)
	READ (5, *) TVAL
	IF (TVAL .EQ. -1) RETURN
	IF (TVAL .LT. 0) GOTO 105
	IF (TVAL .GT. 10000) GOTO 105
	D(1) = ( PVAL * "1000000 ) .OR. TVAL
	D(0) = 1
	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (5, 97)
   97	FORMAT (X, 'NOW ATTEMPTING TO READ IN TIME SLICES')
  200	A = A .AND. "377777		!GET RID OF LEFTOVER WRITE BIT
	D(0) = 2;  D(1)=0; D(2)=0
	CALL SCDEXE
	CALL ERRCON
*		LEAVE PRINTOUT EVEN IF ERROR, HE MIGHT WANT IT
	I1=1; I2=2
	WRITE (5, 95) I1, D(1), I2, D(2)
   95	FORMAT (/,X, 'TIME SLICE FOR PQ', I1, ' IS NOW ', I8,
     1	' MILLISECONDS.')
	RETURN
	END

	SUBROUTINE FUN4
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL
	DIMENSION D(0/128)
*
*		READ/SET DESIRED CHANNEL USAGE FUNCTION
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 200
	WRITE (5, 99)
   99	FORMAT (X, 'GIVE CHANNEL NUMBER AND THEN THE DESIRED',
     1	' PERCENTAGE (0-100)', /, 5X, '(-1 TO EXIT)')
  100	WRITE (5, 98)
   98	FORMAT (//,X, 'WHICH CHANNEL ', $)
	READ (5, *) CVAL
	IF (CVAL .LT. 0) RETURN
	WRITE (5, 96) CVAL
   96	FORMAT (X, 'WHAT PERCENTAGE FOR CHANNEL', I4, '  (0-100) ', $)
	READ (5, *) PVAL
	IF ((PVAL .LT. 0) .OR. (PVAL .GT. 100)) RETURN
	D(0) = 1
	D(1) = CVAL*"1000000 .OR. PVAL
	CALL SCDEXE
	CALL ERRCON
	GOTO 100
*
*
  200	SAVEA = A			!PRESERVE A
	A = "72000011			!GETTAB FOR NUMBER OF CHANNELS
	CALL TABGET
	D(0) = A
	IF (B .EQ. 0) GOTO 300
	WRITE (5, 95)
   95	FORMAT (X, 'HIGHEST CHANNEL NUMBER (0- WHAT) ', $)
	READ (5, *) D(0)
	IF (( D(0) .LE. 0) .OR. (D(0) .GT. 100)) RETURN
	D(0) = D(0) + 1
  300	A = SAVEA			!RESTORE A
	DO 305 I=1, D(0)
  305	D(I) = 0
	CALL SCDEXE
	CALL ERRCON
*		LET PRINTOUT GO, HE MIGHT WANT TO SEE IT
	DO 310 I=1, D(0)
	I1=I-1
  310	WRITE (5, 94) I1, D(I)
   94	FORMAT (X, 'CHANNEL NUMBER', I4, ' HAS ', I3, ' PERCENT.')
	RETURN
	END

	SUBROUTINE FUN5
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL
	DIMENSION D(0/128)
*
*		READ/SET EACH JOB'S CLASS
*
	IF (W .EQ. 1) GOTO 200
   50	WRITE (5, 99) Z
   99	FORMAT (X, 'HIGHEST JOB (1-', I4, ') ', $)
	READ (5, *) D(0)
	IF ( D(0) .EQ. -1) RETURN
	IF ( D(0) .LE. 0) GOTO 50
	IF ( D(0) .GT. Z) GOTO 50
	DO 100 I=1, D(0)
  100	D(I)=0
	CALL SCDEXE
	CALL ERRCON
*		LET ERROR GO, HE WANTS TO SEE TYPE OUT
	DO 110 I=1, D(0)
	SAVEA = A			!PRESERVE A
	A = I * "1000000		!JOB NUMBER IN LEFT HALF
	CALL TABGET			!JOB STATUS FOR JOB I
	IF ((A .AND. "040000000000) .NE. 0) WRITE (5, 97)  I, D(I)
*			IF JOB NUMBER NOT ASSIGNED, DON'T PRINT
   97	FORMAT (X, 'JOB NUMBER', I3, ' IS IN CLASS', I3)
  110	CONTINUE
	A = SAVEA			!RESTORE A (FOR THE HECK OF IT)
	RETURN
*
*
  200	WRITE (5, 96)
   96	FORMAT(//,X, '(-1 MEANS QUIT, 0 MEANS YOURSELF) ', $)
  230	WRITE (5, 94)
   94	FORMAT (//, X, 'WHICH JOB ', $)
	READ (5, *) J
	IF (J .LT. 0) RETURN
	IF (J .EQ. 0) GOTO 210
	IF (J .GT. Z) GOTO 230
	J = J * "1000000
	GOTO 220
  210	J = "777777000000
  220	WRITE (5, 95) HCL
   95	FORMAT (X, 'WHICH CLASS (0-', I2, ') ', $)
	READ (5, *) CLAS
	IF (CLAS .EQ. -1) RETURN
	IF ((CLAS .LT. 0) .OR. (CLAS .GT. HCL)) GOTO 220
	D(0) = 1
	D(1) = J .OR. CLAS
	CALL SCDEXE
	CALL ERRCON
	GOTO 230
	END

	SUBROUTINE FUN6
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z
	DIMENSION D(0/128)
*
*		READ/SET PROT0 (CONSTANT ADDED TO MCU)
*		MEASURED IN MICROSECONDS
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
	WRITE (5, 99)
   99	FORMAT (X, 'NEW VALUE FOR PROT0 (IN MICROSECONDS) ', $)
	READ (5, *) D(0)
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (5, 97) D(0)
   97	FORMAT (X, 'NEW VALUE OF PROT0 IS', I8, ' MICROSECONDS')
	RETURN
	END

	SUBROUTINE FUN7
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL
	DIMENSION D(0/128)
*
*		READ RUNTIME SINCE STARTUP OF EACH CLASS
*		MEASURED IN JIFFIES. ALSO PRINTS OUT THE PERCENTAGE
*		OF RUNTIME FOR EACH CLASS SINCE LAST CLASS QUOTA
*		WAS CHANGED
*
	SAVEA = A
	A = "13000115			!GETTAB VALUE FOR SYS TIME
	CALL TABGET
	SUM = 1				!DEFAULT
	IF ((B .NE. 0) .OR. (A .EQ. 0)) GOTO 100
	SUM = A				!STORE ANSWER IN SUM
  100	A = SAVE A			!RESTORE A
	WRITE (5, 99) HCL
   99	FORMAT (X, 'HIGHEST CLASS (0- ', I2, ') ', $)
	READ (5, *) D(0)
	IF ( D(0) .LT. 0) RETURN
	IF ( D(0) .GT. HCL) RETURN
	D(0) = D(0) + 1
	DO 150 I=1, D(0)
  150	D(I)=0
	CALL SCDEXE
	CALL ERRCON
*			LET ERROR GO, HE WANTS TO SEE IT
	DO 300 I = 1, D(0)
	I1 = I-1
	PERCNT = D(I) * 100 / SUM
  300	WRITE (5, 97) I1, D(I), PERCNT
   97	FORMAT (X, 'RUNTIME SINCE STARTUP BY CLASS', I3, ' IS ', I8,
     1	' JIFFIES  (', I3, ' PERCENT)')
	RETURN
	END

	SUBROUTINE FUN8
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL
	DIMENSION D(0/128)
*
*		READ/SET EXPONENTIAL FACTOR (IE DEPENDANCE ON THE PAST)
*		IN THE RANGE 0-10000
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
	WRITE (5, 99)
   99	FORMAT (X, 'NEW EXPONENTIAL DECAY VALUE (0-10000) ', $)
	READ (5, *) D(0)
	IF ( D(0) .LT. 0) RETURN
	IF ( D(0) .GT. 10000) RETURN
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (5, 97) D(0)
   97	FORMAT (X, 'NEW EXPONENTIAL FACTOR IS ', I8)
	RETURN
	END

	SUBROUTINE FUN9
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL
	DIMENSION D(0/128)
*
*		READ/SET VALUE OF PROT (MCU MULTIPLIER)
*		MEASURED IN MICROSECONDS
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
	WRITE (5, 99)
   99	FORMAT (X, 'NEW VALUE OF PROT (IN MICROSECONDS) ', $)
	READ (5, *) D(0)
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (5, 97) D(0)
   97	FORMAT (X, 'NEW PROT IS ', I8, ' MICROSECONDS')
	RETURN
	END
	SUBROUTINE MAKMAP
	IMPLICIT INTEGER (A-Z)
*
*		THIS FUNCTION ALLOWS THE SYSTEM ADMINISTRATOR
*		TO INTERACTIVELY BUILD A SCDMAP.SYS FILE
*
	PARAMETER FUNLEN=10		!NUMBER CHARS PER FUN
	PARAMETER NOFUNS=7		!NUMBER FUNCTIONS
	PARAMETER MINCHR=1		!MIN ABBREVICTION
	PARAMETER FL=2			!FUNLEN+4/5
*
	DIMENSION M(0/1023), M1(0/255)
	DIMENSION SRCSTR(80)
	DIMENSION CLIST(FL,NOFUNS)
	DIMENSION CLISTD(3)
	DIMENSION CLISTA(FUNLEN,NOFUNS)
*
	DATA (CLIST(I,1),I=1,FL)/'HELP     '/
	DATA (CLIST(I,2),I=1,FL)/'EXIT     '/
	DATA (CLIST(I,3),I=1,FL)/'READ     '/
	DATA (CLIST(I,4),I=1,FL)/'WRITE    '/
	DATA (CLIST(I,5),I=1,FL)/'RANGE    '/
	DATA (CLIST(I,6),I=1,FL)/'ONE CLASS'/
	DATA (CLIST(I,7),I=1,FL)/'TYPE     '/
*
	DATA (CLISTD(I),I=1,3)/FUNLEN,NOFUNS,MINCHR/
*
	DATA BLANK,COMMA/' ',',    '/
*
	DO 10 I=1,NOFUNS
	  DECODE (FUNLEN,9999,CLIST(1,I))(CLISTA(J,I),J=1,FUNLEN)
   10	CONTINUE
 9999	FORMAT (80A1)
*
	WRITE (5, 99)
   99	FORMAT (//,X,'MAKMAP SUBFUCTION: MANIPULATE A SCDMAP.SYS FILE',
     1	/, 5X,  'TYPE HELP FOR HELP')
  100	WRITE (5, 98)
   98	FORMAT (/, X, '(MAKMAP LEVEL)', /, X, 'WHAT FUNCTION ', $)
	READ (5,196) (SRCSTR(I),I=1,80)
  196	FORMAT (80A1)
	DO 20 I=1,60
	  IF (SRCSTR(I) .NE. BLANK) GOTO 30
   20	CONTINUE
	GOTO 100
   30	F=STRMCH(CLISTA(1,1),CLISTD(1),SRCSTR(I))
	IF (F .LT. 3) GOTO 110
  105	WRITE (5, 86)
   86	FORMAT (X, 'WHICH MAP (0=TIMESHARE, 1=BATCH) ', $)
	READ (5,*) TB
	IF (TB .EQ. -1) GOTO 100
	IF (TB .LT. 0) GOTO 105
	IF (TB .GT. 1) GOTO 105
  110	GOTO (1000,9980, 9990, 10000, 10010, 10020, 10030, 10040) F+1
**************************************************
*		TYPE OUT HELP TEXT
*
 9980	WRITE (5, 97) ((CLIST(I,J),I=1,FL),J=1,NOFUNS)
   97	FORMAT (X, 'FUNCTION:',
     1	/, 4X, 2A5,  '- TYPE THIS TEXT',
     2	/, 4X, 2A5,  '- EXIT',
     3	/, 4X, 2A5,  '- READ IN A SCDMAP.SYS FILE FOR MODIFICATION',
     4	/, 4X, 2A5,  '- WRITE OUT CURRENT DATA AS A SCDMAP.SYS FILE',
     5	/, 4X, 2A5,  '- CHANGE A RANGE OF SCHED TYPES TO A CLASS',
     6	/, 4X, 2A5,  '- CHANGE ONE SCHED TYPE TO A CLASS',
     7	/, 4X, 2A5,  '- TYPE OUT A RANGE OF TYPES AND THEIR CLASSES',//)
	GOTO 100
**************************************************
*		GO BACK TO TOP LEVEL
*
 9990	RETURN
**************************************************
 1000	WRITE (5,9998)
	GOTO 100
 9998	FORMAT (' %INPUT ERROR, REENTER OR TYPE HELP')
**************************************************
*		READ IN A SCDMAP.SYS FILE FOR MODIFICATION
*
10000	DIRECT= 'SEQIN' ; GOTO 10011
10001	READ (20,ERR=10003) M1
	CLOSE (UNIT=20)
	DO 10002 I=0, 255
	M(I*4+0) = ( M1(I) / "1000000000) .AND. "777
	M(I*4+1) = ( M1(I) / "1000000) .AND. "777
	M(I*4+2) = ( M1(I) / "1000) .AND. "777
10002	M(I*4+3) = M1(I) .AND. "777
	WRITE (5, 96)
   96	FORMAT (/, X, 'INPUT COMPLETE, FILE CLOSED',/)
	GOTO 100
10003	WRITE (5, 88)
   88	FORMAT (X, 'ERROR ON INPUT FILE')
	CLOSE (UNIT=20)
	GOTO 100
**************************************************
*		WRITE OUT CURRENT DATA AS A SCDMAP.SYS FILE
*
10010	DIRECT = 'SEQOUT'
10011	OPEN (UNIT=20, ACCESS=DIRECT, MODE='DUMP',
     1	DEVICE='DSK', FILE='SCDMAP.SYS', DIRECTORY='1,2', DIALOG)
	IF (DIRECT .EQ. 'SEQIN') GOTO 10001
	DO 10012 I=0, 255
	M1(I) = ( ("777 .AND. M(I*4+0) ) * "1000000000) .OR.
     1		( ("777 .AND. M(I*4+1) ) * "1000000) .OR.
     2		( ("777 .AND. M(I*4+2) ) * "1000) .OR.
     3		( "777 .AND. M(I*4+3) )
10012	CONTINUE
	WRITE (20, ERR=10013) M1
	CLOSE (UNIT=20)
	WRITE (5, 95)
   95	FORMAT (/, X, 'OUTPUT COMPLETE, FILE CLOSED', /)
	GOTO 100
10013	WRITE (5, 87)
   87	FORMAT (X, 'ERROR ON OUTPUT FILE')
	CLOSE (UNIT=20)
	GOTO 100
**************************************************
**************************************************
*		CHANGE A RANGE OF SCD TYPES TO A CLASS
*
10020	WRITE (5, 94)
   94	FORMAT (X, 'WHAT RANGE (SEPARATE BY COMMAS) (0,511) ', $)
	READ (5, *) R1, R2
	IF ((R1 .LT. 0) .OR. (R2 .LT. 0)) GOTO 100
	IF ((R1 .GT. 511) .OR. (R2 .GT. 511)) GOTO 100
	IF (R1 .LT. R2) GOTO 10021
	R3=R1; R1=R2; R2=R3
10021	WRITE (5, 93) R1, R2
   93	FORMAT (X, 'SAME CLASS FOR ', I3, ' THRU ', I3, ' (1=YES) ', $)
	READ (5, *) YESNO
	IF (YESNO .NE. 1) YESNO = 0
	DO 10022 I=R1, R2
	IF ((I .GT. R1) .AND. (YESNO .EQ. 1)) GOTO 10022
	WRITE (5, 92) I
   92	FORMAT (X, 'TYPE: ', I3, '  CLASS: ', $)
	READ (5, *) CLASS
10022	M(I + (TB*512)) = CLASS
	GOTO 100
**************************************************
*		CHANGE ONE SCD TYPE TO A CLASS
*
10030	WRITE (5, 91)
   91	FORMAT (X, 'GIVE TYPE AND CLASS SEPARATED BY COMMAS ', $)
	READ (5, *) R1, R2
	IF ((R1 .LT. 0) .OR. (R1 .GT. 511)) GOTO 100
	IF ((R2 .LT. 0) .OR. (R2 .GT. 31)) GOTO 100
	M(R1 + (TB*512)) = R2
	GOTO 100
**************************************************
*		TYPE OUT A RANGE OF TYPES AND THEIR CLASSES
*
10040	WRITE (5, 90)
   90	FORMAT (X, 'WHAT RANGE (SEPARATE BY COMMAS) (0,511) ', $)
	READ (5, *) R1, R2
	IF ((R1 .LT. 0) .OR. (R2 .LT. 0)) GOTO 100
	IF ((R1 .GT. 511) .OR. (R2 .GT. 511)) GOTO 100
	IF (R1 .LE. R2) GOTO 10041
	R3=R1; R1=R2; R2=R3
10041	WD='TMSHR'
	IF (TB .NE. 0) WD = 'BATCH'
	DO 10042 I=R1, R2
	II=I+(TB*512)
10042	WRITE (5, 89) I, WD, M(II)
   89	FORMAT (X, 'SCD TYPE ', I4, 2X, A5, ' MAPS TO CLASS ', I2)
	GOTO 100
**************************************************
	END

	SUBROUTINE FIXJOB
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z
	DIMENSION D(0/128), M(0/1023), M1(0/255)
*
	WRITE (5, 97)
   97	FORMAT (X, 'DO YOU WISH TO MOVE A SCDMAP.SYS FILE TO SYS:',
     1	' (1=YES) ', $)
	READ (5, *) YESNO
	IF (YESNO .EQ. 1) CALL MOVSCD	!HAD TO REMIND HIM.
*
	OPEN (UNIT=20, DEVICE='SYS', FILE='SCDMAP.SYS', ACCESS='SEQIN',
     1	MODE='DUMP')
	READ (20) M1
	DO 100 I=0, 255
	M ((I*4)+0) = (M1(I) / "1000000000) .AND. "777
	M ((I*4)+1) = (M1(I) / "1000000) .AND. "777
	M ((I*4)+2) = (M1(I) / "1000) .AND. "777
  100	M ((I*4)+3) = (M1(I)) .AND. "777
	CLOSE (UNIT=20)
	CALL MYJOB
	ME = A
*
*		NOW THAT WE HAVE READ IN THE CURRENT MAP,
*		WE SCAN ALL LOGGED IN JOBS AND RESET THEIR CLASS
*		FROM THE TYPE STORED IN ACCT.SYS.  THE ONLY JOBS
*		SKIPPED ARE [2,5] JOBS AND THIS JOB. BATCH JOBS
*		GET THE VALUE FROM THE BATCH MAP.
*
	DO 200 I=1, Z
	IF (I .EQ. ME) GOTO 200		!IF MY JOB THEN SKIP IT
	A = I * "1000000 + 2		!GETTAB AC FOR JOB I'S PPN
	CALL TABGET			!DO THE GETTAB
	IF (B .NE. 0) GOTO 200		!IF ERROR THEN NO JOB
	IF (A .EQ. 0) GOTO 200		!IF ZERO PPN, NO JOB
	IF (A .EQ. "2000005) GOTO 200	!IF PPN = [2,5] SKIP IT
	PPN = A				!SAVE A (ITS THE PPN)
	A = I*"1000000 + "40		!GETTAB FOR BATCH STATUS WORD
	CALL TABGET
	IF (B .NE. 0) GOTO 150		!GETTAB FAILED??
	TB = 0				!DEFAULT TO NOT BATCH
	IF ((A .AND. "200000000) .NE. 0) TB = 1		!IT IS BATCH
  150	A = PPN				!RESTORE A AND CONTINUE
	CALL SCANAC			!SCAN ACCT.SYS FOR HIS PPN
	IF (B .NE. 0) GOTO 200		!HE'S NOT IN ACCT.SYS
	D(0) = 1
	D(1) = I * "1000000 + M(A + (TB*512))	!SET UP ARGS FOR UUO
	A = "400005
	CALL SCDEXE			!DO THE UUO
	IF (B .NE. 0) GOTO 300		!SCHED. UUO FAILED, TELL THE MAN
	GOTO 200
  300	WRITE (5, 98) I
   98	FORMAT (/, X, 'SCHED. UUO FAILED FOR JOB ', I4)
	CALL ERRCON			!TELL HIM THE ERROR
  200	CONTINUE
	WRITE (5, 99)
   99	FORMAT (//, X, 'ALL OTHER JOBS DONE.')
	RETURN
	STOP
	END

	SUBROUTINE SCANAC
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z
	DIMENSION D(0/128), ACCT(1/14)
*
*		SCAN ACCT.SYS FOR THE SCD TYPE OF THIS PPN
*		TAKES PPN IN A,  RETURNS SCD TYPE IN A
*
	OPEN (UNIT=20, DEVICE='SYS', FILE='ACCT.SYS', ACCESS='SEQIN',
     1	MODE='IMAGE')
	READ (20) B			!GET NAMETAG OF ACCT.SYS
	IF (B .NE. "4000016) GOTO 998	!RIGHT VERSION OF ACCT.SYS?
	B = 0				!CLEAR ERROR FLAG
  100	READ (20, END=999) ACCT
	IF (A .NE. ACCT(1)) GOTO 100
	A = (ACCT(14) / "777000) .AND. "1000
  200	CLOSE (UNIT=20)
	RETURN
*
  999	WRITE (5, 88) A
   88	FORMAT (X, 'USER ', O12, ' NOT IN ACCT.SYS')
	B=1; A=0; GOTO 200		!HE WASN'T IN ACCT.SYS
  998	WRITE (5, 89)
   89	FORMAT (X, 'WRONG VERSION OF ACCT.SYS')
	STOP
	END
	SUBROUTINE MOVSCD
	IMPLICIT INTEGER (A-Z)
	DIMENSION M(0/255)
*
*		THIS ROUTINE MOVES A SCDMAP.SYS FILE TO THE
*		SYSTEM AREA. PIP SHOULD BE ABLE TO DO THE JOB,
*		BUT THIS FUNCTION IS PROVIDED FOR THE CONVENIENCE
*		OF THE SYSTEM ADMINISTRATOR.
*
	WRITE (5, 93)
   93	FORMAT (X, 'WHAT FILE DO YOU WISH TO MOVE TO SYS')
	OPEN (UNIT=20, ACCESS='SEQIN', MODE='DUMP', DEVICE='DSK',
     1	FILE='SCDMAP.SYS', DIRECTORY='1,2', DIALOG)
	READ (20, END=999, ERR=998) M
	CLOSE (UNIT=20)
	WRITE (5, 99)
   99	FORMAT (X, 'FILE SUCCESSFULLY READ IN.')
	OPEN (UNIT=20, ACCESS='SEQOUT', MODE='DUMP', DEVICE='SYS',
     1	FILE='SCDMAP.SYS', DIRECTORY='', DIALOG)
	WRITE (20, ERR=997) M
	CLOSE (UNIT=20)
	WRITE (5, 98)
   98	FORMAT (X, 'FILE SUCCESSFULLY WRITTEN OUT.')
	RETURN
  999	WRITE (5, 96)
   96	FORMAT (X, 'REACHED END OF FILE TOO SOON.')
	CLOSE (UNIT=20)
	RETURN
  998	WRITE (5, 95)
   95	FORMAT (X, 'ERROR IN READING FILE.')
	CLOSE (UNIT=20)
	RETURN
  997	WRITE (5, 94)
   94	FORMAT (X, 'COULD NOT WRITE FILE TO SYS:')
	CLOSE (UNIT=20)
	RETURN
	END
	INTEGER FUNCTION STRMCH(ALIST,ALISTD,SRC)
	IMPLICIT INTEGER (A-Z)
	DIMENSION ALIST(200), SRC(80), ALISTD(3)
*
*	STRMCH IS A FUNCTION SUBPROGRAM WHICH WILL
*	LOCATE AN OCCURRENCE OF A STRING (COMMAND)
*	IN A TABLE OF POSSIBLE COMMAND STRINGS.  A 
*	COMMAND IS DEFINED AS AN OCCURRENCE OF AN 
*	UNAMBIGUOUS SUBSTRING OF A PRESPECIFIED MINIMUM
*	LENGTH WHICH MATCHES EXACTLY THE CORRESPONDING
*	SUBSTRING OF A COMMAND IN THE COMMAND TABLE.
*
*	THIS SUBROUTINE ACCEPTS THREE INPUT ARRAYS:
*	  ALIST IS A TWO DIMENSIONAL ARRAY OF POSSIBLE 
*	  COMMANDS.  THE FIRST SUBSCRIPT ITERATES ON
*	  ON THE CHARACTERS IN THE COMMAND (IN A1 FORMAT)
*	  AND THE SECOND SUBSCRIPT ITERATES ON THE 
*	  COMMANDS.
*	 -ALISTD IS A DESCRIPTOR ARRAY OF LENGTH 3.
*	    THE FIRST ELEMENT IS THE MAX NUMBER OF CHARACTERS
*	    PER COMMAND.
*	    THE SECOND ELEMENT IS THE NUMBER OF COMMANDS.
*	    THE THIRD ELEMENT IS THE MINIMUM NUMBER OF
*	    CHARACTERS WHICH MUST MATCH TO BE CONSIDERED
*	    AS A MATCH ON THE ENTIRE COMMAND.
*	 -  SRC IS A CHARACTER ARRAY (IN A1 FORMAT) WHICH
*	    CONTAINS THE COMMAND TO BE SEARCHED.
*
	DATA BLANK/'    '/,COMMA/',    '/
	Q1 = ALISTD(1)
	Q2 = ALISTD(2)
	K=0
	AMB = 0
	CURMCH = 0
	MINMCH = ALISTD(3)
	DO 30 I=1,Q2 		
	  Q3 = (I-1)*Q1
	  DO 10 J=1,Q1		
	    Q3 = Q3 + 1
	    IF (ALIST(Q3) .NE. SRC(J)) GOTO 20
10	  CONTINUE
	  J = Q1
20	  J = J-1		
	  IF(SRC(J+1) .NE. BLANK .AND. SRC(J+1) .NE. COMMA) J=0
	  IF (J .LT. MINMCH) J=0
	  IF (J .LT. CURMCH) GOTO 30
	  K=I
	  AMB = 0
	  IF (J .EQ. CURMCH) AMB = 1
	  CURMCH = J
30	CONTINUE
	IF (AMB .NE. 0) K=0
	STRMCH = K
	RETURN
	END