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