Google
 

Trailing-Edge - PDP-10 Archives - BB-F494Z-DD_1986 - 10,7/scdset.for
There are 9 other files named scdset.for in the archive. Click here to see a list.
*SCDSET.FOR - SYSTEM ADMINISTRATOR SCHEDULAR PARAMETER SETTING PROGRAM

*COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975,1978,1979,1980,1983,1984,1985,1986.
*ALL RIGHTS RESERVED.
*
*
*THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
*ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
*INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
*COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
*OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
*TRANSFERRED.
*
*THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
*AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
*CORPORATION.
*
*DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
*SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

*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: MAY, 1977
* 	4	REPLACE NUMERIC FUNCTION SELECTION WITH 
*		COMMANDS
*	VERSION 3:  JANUARY, 1978
*	5	ADD FUNCTIONS 11-23 FOR WMU CLASS SCHEDULER
*	6	ALLOW SPACE AS DELIMITER BETWEEN COMMAND AND FUNCTION
*
*	7	ALLOW UPPER AND LOWER CASE IN COMMAND TYPEIN
*	10	(QAR 10-02469) ALLOW NULL COMMANDS WITHOUT ERROR MSG
*	VERSION 3A:  MARCH, 1979
*
*	11	ALLOW 511 JOBS
*	12	ONE MORE TRY AT EDIT 11
*	VERSION 4:   MAY, 1983
*
*	VERSION 5: FEBRUARY 1985
*	14	ADD FUNCTION 25 FOR HIGH SEGMENT RETENTION TIMES AND FUNCTION
*		26 FOR SETTING CORE LIMITS/GOALS
*	15	ADD FUNCTION 24 TO SUPPORT CHANGING SCHEDULER QUEUE SCAN ORDER
*	16	CHANGE SCANAC TO CALL NEW ROUTINE PROGET (IN SCDEXE.MAC) TO
*		RETURN USER PROFILE WHICH CONTAINS SCHED CLASS.
*	17	MAKE MOVSCD CALL NEW ROUTINE NEWSCD (IN SCDEXE.MAC) WHICH
*		TELLS ACTDAE TO REREAD SYS:SCDMAP.SYS.
*	20	REMOVE A "DIRECTORY=' '" FROM AN OPEN IN MOVSCD.
*	21	9-AUG-85 DO COPYRIGHTS.
	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=27		!NUMBER FUNCTIONS
	PARAMETER MINCHR=1		!MIN ABBREVICTION
	PARAMETER CMDLEN=20		!NUMBER CHARS PER COMMAND
	PARAMETER NOCMDS=9
	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, INU, OUTU
	DIMENSION D(0:512)
*
*		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).
*
	CHARACTER*132 CRLF*2,COPY,COPYRI
	PARAMETER (CRLF=CHAR(13)//CHAR(10))
	PARAMETER (COPY=CRLF//CRLF//'COPYRIGHT (c)'//
	1 ' DIGITAL EQUIPMENT CORPORATION 1975,1986.'//
	2 CRLF//'ALL RIGHTS RESERVED.'//CRLF//CRLF)
	DATA COPYRI/COPY/
	DATA (CLIST(I,1),I=1,FL)/'MS INTERVAL       '/
	DATA (CLIST(I,2),I=1,FL)/'MCU INTERVAL        '/
	DATA (CLIST(I,3),I=1,FL)/'PRIMARY PERCENTAGES '/
	DATA (CLIST(I,4),I=1,FL)/'TIME BASE           '/
	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 (CLIST(I,11),I=1,FL)/'DEFAULT CLASS       '/
	DATA (CLIST(I,12),I=1,FL)/'PROT1               '/
	DATA (CLIST(I,13),I=1,FL)/'PROTM               '/
	DATA (CLIST(I,14),I=1,FL)/'TIME MULTIPLIER     '/
	DATA (CLIST(I,15),I=1,FL)/'TIME MAXIMUM        '/
	DATA (CLIST(I,16),I=1,FL)/'SECONDARY ALLOCATION'/
	DATA (CLIST(I,17),I=1,FL)/'RESPONSE FAIRNESS   '/
	DATA (CLIST(I,18),I=1,FL)/'AVG SWAP TIME       '/
	DATA (CLIST(I,19),I=1,FL)/'BB CLASS            '/
	DATA (CLIST(I,20),I=1,FL)/'BB SWAP TIME        '/
	DATA (CLIST(I,21),I=1,FL)/'SCHEDULER FAIRNESS  '/
	DATA (CLIST(I,22),I=1,FL)/'SWAPPER FAIRNESS    '/
	DATA (CLIST(I,23),I=1,FL)/'INCORE FAIRNESS     '/
	DATA (CLIST(I,24),I=1,FL)/'CORE SCHED INTERVAL '/
	DATA (CLIST(I,25),I=1,FL)/'QUEUE SCAN ORDER    '/
	DATA (CLIST(I,26),I=1,FL)/'HI SEG IN CORE TIME '/
	DATA (CLIST(I,27),I=1,FL)/'FREE CORE LIMITS    '/
	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)/'INPUT              '/
	DATA (DLIST(I,7),I=1,CL)/'OUTPUT             '/
	DATA (DLIST(I,8),I=1,CL)/'READ               '/
	DATA (DLIST(I,9),I=1,CL)/'SET                '/
	DATA (DLISTD(I),I=1,3)/CMDLEN,NOCMDS,MINCHR/
*
	DATA BLANK,COMMA,TAB,ALTMOD/' ',',','	',"155004020100/
	DATA LOWERA,LOWERZ/"605004020100,"751004020100/
*
	INU=5
	OUTU=5
	INOPN=0
	OUTOPN=0
	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 (OUTU, 99) Z, HCL1
  100	IF (INU.NE.5.OR.OUTU.NE.5) WRITE (OUTU, 998)
	IF (INU.EQ.5) WRITE (5,98)
	READ (INU,97,END=690) (SRCSTR(I),I=1,60)
	CALL MAPCSE(SRCSTR,60)
*
*
	DO 101 I=1,60
	CHR=SRCSTR(I)
	IF (CHR.EQ.TAB) SRCSTR(I)=BLANK
	IF (CHR.EQ.ALTMOD) SRCSTR(I)=BLANK
	IF (CHR.GE.LOWERA.AND.CHR.LE.LOWERZ)
     2       SRCSTR(I)=SRCSTR(I)-"200000000000
  101	CONTINUE
	DO 20 I=1,60
	  IF (SRCSTR(I) .NE. BLANK) GOTO 30
   20	CONTINUE
	GOTO 100
   30	CMD = STRMCH(DLISTA(1,1),DLISTD(1),SRCSTR(I))
	J=I
	DO 40 I=I,60
	  IF (SRCSTR(I) .EQ. COMMA) GOTO 50
   40	CONTINUE
	DO 45 I=J,60
	  IF (SRCSTR(I) .EQ. BLANK) GOTO 50
   45	CONTINUE
	FUN=0
	GOTO 80
   50	J=I
	I=I+1
	DO 60 I=I,60
	IF (SRCSTR(I) .NE. BLANK) GOTO 70
   60	CONTINUE
	IF (SRCSTR(J) .EQ. COMMA) GOTO 500
	FUN=0
	GOTO 80
   70	FUN = STRMCH(CLISTA(1,1),CLISTD(1),SRCSTR(I))-1
*
   80	GOTO (500,200,205,210,215,220,225,230,235,240), CMD+1
  200	WRITE (OUTU,88) ((DLIST(I,J),I=1,CL),J=1,NOCMDS),
     1      (CLIST(I,1),I=1,FL),
     1      (CLIST(I,3),I=1,FL),
     1      (CLIST(I,4),I=1,FL),
     1      (CLIST(I,6),I=1,FL),
     1      (CLIST(I,7),I=1,FL),
     1      (CLIST(I,8),I=1,FL),
     1      ((CLIST(I,J),I=1,FL),J=10,NOFUNS)
	GOTO 100
  205	STOP;          GOTO 100
  210	CALL FIXJOB;   GOTO 100
  215	CALL MAKMAP;   GOTO 100
  220	CALL MOVSCD;   GOTO 100
  225	W=0;           GOTO 600
  230	W=1;           GOTO 650
  235	W=0;           GOTO 250
  240	W=1
  250	A = FUN .OR. (W*"400000)
*
	GOTO (500,300,305,310,315,320,325,330,335,340,345,350,
     1    355,360,365,370,375,380,385,390,395,400,405,410,415,
     2    420,425,430), FUN+2
  300	CALL FUN0;   GOTO 100
  305	CALL FUN1;   GOTO 100
  310	CALL FUN2;   GOTO 100
  315	CALL FUN3;   GOTO 100
  320	CALL FUN4;   GOTO 100
  325	CALL FUN5;   GOTO 100
  330	CALL FUN6;   GOTO 100
  335	CALL FUN7;   GOTO 100
  340	CALL FUN8;   GOTO 100
  345	CALL FUN9;   GOTO 100
  350	CALL FUN10;  GOTO 100
  355	CALL FUN11;  GOTO 100
  360	CALL FUN12;  GOTO 100
  365	CALL FUN13;  GOTO 100
  370	CALL FUN14;  GOTO 100
  375	CALL FUN15;  GOTO 100
  380	CALL FUN16;  GOTO 100
  385	CALL FUN17;  GOTO 100
  390	CALL FUN18;  GOTO 100
  395	CALL FUN19;  GOTO 100
  400	CALL FUN20;  GOTO 100
  405	CALL FUN21;  GOTO 100
  410	CALL FUN22;  GOTO 100
  415	CALL FUN23;  GOTO 100
  420	CALL FUN24;  GOTO 100
  425	CALL FUN25;  GOTO 100
  430	CALL FUN26;  GOTO 100
  500	IF (OUTU.NE.5.AND.INU.EQ.5) WRITE (5,96)
	WRITE (OUTU,96)
	GOTO 100
  600	IF (INU .NE. 5) GOTO 625
	INU=21
	IF (INOPN .EQ. 0) OPEN(UNIT=INU,DEVICE='DSK',
     1	  FILE='SCDSET.INP',ACCESS='SEQIN',MODE='ASCII')
	INOPN=-1
	WRITE (OUTU,601)
	IF (OUTU .NE. 5) WRITE (5,601)
	GOTO 100
  625	INU=5
	WRITE (OUTU,602)
	IF (OUTU .NE. 5) WRITE (5,602)
	GOTO 100
  650	IF (OUTU .NE. 5) GOTO 675
	WRITE (OUTU,603)
	OUTU=22
	IF (OUTOPN .EQ. 0) OPEN(UNIT=OUTU,DEVICE='DSK',
     1	  FILE='SCDSET.OUT',ACCESS='SEQOUT',MODE='ASCII')
	OUTOPN=-1
	WRITE (OUTU,603)
	GOTO 100
  675	WRITE (OUTU,604)
	OUTU=5
	WRITE (OUTU,604)
	GOTO 100
  690	CLOSE(UNIT=INU)
	INOPN=0
	GOTO 625
  601	FORMAT (/, X, 'INPUT IS NOW FROM DSK:SCDSET.INP'/)
  602	FORMAT (/, X, 'INPUT IS NOW FROM TTY:'/)
  603	FORMAT (/, X, 'OUTPUT IS NOW TO DSK:SCDSET.OUT'/)
  604	FORMAT (/, X, 'OUTPUT IS NOW TO TTY:'/)
*
*
   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',
     C	/, 4X, 4A5,'- CHANGE INPUT FROM TTY: TO DSK:SCDSET.INP',
     C	/, 4X, 4A5,'- CHANGE OUTPUT FROM TTY: TO DSK:SCDSET.OUT',
     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,'- MICRO SCHEDULING INTERVAL',
     2	/, 4X, 4A5,'- SYSTEM USAGE PERCENTAGE FOR A SCHEDULER CLASS',
     3	/, 4X, 4A5,'- BASE TIME SLICE FOR EITHER RUN QUEUE',
     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',
     9	/, 4X, 4A5,'- PROT (MCU MULTIPLIER)',
     A	/, 4X, 4A5,'- DEFAULT CLASS AT LOGIN',
     A	/, 4X, 4A5,'- PROT1 (MCU REQUEUE CONSTANT)',
     A	/, 4X, 4A5,'- PROTM (MCU MAXIMUM)',
     B	/, 4X, 4A5,'- TIME SLICE MULTIPLIER AND SCALE FACTOR',
     C	/, 4X, 4A5,'- TIME SLICE MAXIMUM FOR EITHER RUN QUEUE',
     D	/, 4X, 4A5,'- SECONDARY ALLOCATION FOR A SCHEDULER CLASS',
     1	/, 4X, 4A5,'- FAIRNESS PERCENT FOR RESPONSE VS ACCURACY',
     2	/, 4X, 4A5,'- AVERAGE SWAP TIME ESTIMATE',
     3	/, 4X, 4A5,'- BACKGROUND BATCH CLASS',
     4	/, 4X, 4A5,'- BACKGROUND BATCH SWAP TIME INTERVAL',
     5  /, 4X, 4A5,'- SCHEDULER FAIRNESS FACTOR FOR PQ1 VS PQ2',
     6  /, 4X, 4A5,'- SWAPPER FAIRNESS FACTOR FOR PQ1 VS PQ2',
     7  /, 4X, 4A5,'- SWAPPER FAIRNESS PERCENT FOR INCORE VS OUTCORE',
     8  /, 4X, 4A5,'- CORE SCHEDULING INTERVAL',
     9	/, 4X, 4A5,'- QUEUE SCAN ORDER (PQ1, PQ2) OR (PQ2, PQ1)',
     9  /, 4X, 4A5,'- HIGH SEGMENT RETENTION TIME',
     9  /, 4X, 4A5,'- FREE CORE GOALS/LIMITS (PERCENT OF USER CORE)')
   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 ', $)
  998	FORMAT (/, X, '(TOP LEVEL)', /, X,
     1	'WHICH FUNCTION DO YOU WANT ')
   99	FORMAT(1X,'SYSTEM ADMINISTRATOR SCHEDULER SETTING PROGRAM',
     A	',  VERSION 3.',/, 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 MAPCSE(ARRAY,LENGTH)
	IMPLICIT INTEGER (A-Z)
	DIMENSION ARRAY(LENGTH)

*  CASE FOLDS AN ARRAY IN A1 FORMAT

	DO 10 I = 1,LENGTH
	IF (ARRAY(I) .LT. 0) ARRAY(I) = ARRAY(I) .AND. "577777777777
10	CONTINUE
	RETURN
	END

	SUBROUTINE TTYMOD
*		RETURNS PROGRAM TO INTERACTIVE MODE.
*		CALLED ON COPY, EDIT, AND POSSIBLY UPDATE COMMANDS
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
	OLDOUT=OUTU
	IF (OUTU .EQ. 5) GOTO 100
	WRITE (OUTU,604)
	OUTU=5
	WRITE (OUTU,604)
  100	IF (INU .EQ. 5) GOTO 200
	WRITE (OUTU,602)
	IF (OLDOUT .NE. OUTU) WRITE (OLDOUT,602)
	INU=5
  200	RETURN
  602	FORMAT (/, X, 'INPUT IS NOW FROM TTY:'/)
  604	FORMAT (/, X, 'OUTPUT IS NOW TO TTY:'/)
	END

	SUBROUTINE ERRCON
*		HANDLES ERROR REPORTING
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
	IF (B .EQ. 0 ) GOTO 110
	WRITE (OUTU, 83)
	IF ((B .LT. 0) .OR. (B .GT. 14))  GOTO 100
	GOTO (1,2,3,4,5,6,7,8,9,10,11,12,13,14) B
    1	WRITE(OUTU,91); GOTO 300
    2	WRITE(OUTU,92); GOTO 300
    3	WRITE(OUTU,93); GOTO 300
    4	WRITE(OUTU,94); GOTO 300
    5	WRITE(OUTU,95); GOTO 300
    6	WRITE(OUTU,96); GOTO 300
    7	WRITE(OUTU,97); GOTO 300
    8	WRITE(OUTU,98); GOTO 300
    9	WRITE(OUTU,99); GOTO 300
   10	WRITE(OUTU,200); GOTO 300
   11	WRITE(OUTU,201); GOTO 300
   12	WRITE(OUTU,202); GOTO 300
   13	WRITE(OUTU,203); GOTO 300
   14	WRITE(OUTU,204); GOTO 300
  100	WRITE(OUTU,81) B; GOTO 300
  110	WRITE(OUTU,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)',/)
  200	FORMAT(X, 'NOT CLASS SCHEDULER',/)
  201	FORMAT(X, 'PRIMARY DOES NOT ADD TO 100%',/)
  202	FORMAT(X, 'FAIRNESS NOT POSITIVE',/)
  203	FORMAT(X, 'ILLEGAL CPU',/)
  204	FORMAT(X, 'UNKNOWN SCAN ORDER',/)
	END

	SUBROUTINE FUN0
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READS OR SETS THE MICRO SCHEDULING INTERVAL
*		(THE INTERVAL AT WHICH THE SCHEDULING SCAN TABLES ARE
*		REBUILT)  THE MEASUREMENT IS IN JIFFIES.
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
  101	WRITE (OUTU, 99)
   99	FORMAT(X, 'NEW VALUE FOR THE MICRO SCHED. INTERVAL:',
     1	' (IN JIFFIES) ', $)
	READ (INU, *) 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 (OUTU, 97) D(0)
   97	FORMAT (X, 'MICRO 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, HCL, INU, OUTU
	DIMENSION D(0:512)
	WRITE(OUTU, 99)
   99	FORMAT (X, 'MCU INTERVAL IS A HISTORICAL FUNCTION',
     1      ' NO LONGER IMPLEMENTED')
	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, INU, OUTU
	DIMENSION D(0:512)
	GOTO (100,101) W+1
*
  100	WRITE (OUTU, 99) HCL
   99	FORMAT (X, 'HIGHEST CLASS (0-', I2, ') ', $)
	READ (INU, *) 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 (OUTU, 97) I1, D(I), F
   97	FORMAT (X, 'CLASS:',I2,'  PERCENTAGE OF SYSTEM:',I3, 1X, A1)
	RETURN
*
  101	TOPCLS = 0
	WRITE (OUTU, 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 (OUTU, 95)
   95	FORMAT (/,X,'CLASS: ', $)
	READ (INU, *) CVAL
	IF (CVAL .EQ. -1) GOTO 200
	IF (CVAL .LT. 0) GOTO 150
	IF (CVAL .GT. HCL) GOTO 150
  155	WRITE (OUTU, 93)
   93	FORMAT (X, 'PERCENTAGE OF SYSTEM (0-100): ', $)
	READ (INU, *) PVAL
	IF (PVAL .EQ. -1) GOTO 200
	IF (PVAL .LT. 0) GOTO 155
	IF (PVAL .GT. 100) GOTO 155
	WRITE (OUTU, 92)
   92	FORMAT (X, 'FIXED SWAPIN? (1=YES) ', $)
	READ (INU, *) FVAL
	IF (FVAL .EQ. -1) GOTO 200
	IF (FVAL .NE. 1) FVAL = 0
	IF (TOPCLS .LT. 128) TOPCLS = TOPCLS + 1
	D(TOPCLS) = FVAL*"400000000000 .OR. CVAL*"1000000 .OR. PVAL
	GOTO 150
  200	IF (TOPCLS .EQ. 0) RETURN
	D(0) = TOPCLS
	CALL SCDEXE
	CALL ERRCON
	RETURN
	END

	SUBROUTINE FUN3
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READ/SET TIME SLICES FOR THE TWO QUEUES.
*		MEASURED IN MILLISECONDS
*
	IF (W .EQ. 0) GOTO 200
  100	WRITE (OUTU, 99)
   99	FORMAT (X, 'CHANGE BASE TIME SLICE OF WHICH PQ (1-2) ', $)
	READ (INU, *) PVAL
	IF (PVAL .EQ. -1) RETURN
	IF ( PVAL .LT. 1) GOTO 100
	IF ( PVAL .GT. 2) GOTO 100
  105	WRITE (OUTU, 98) PVAL
   98	FORMAT (X, 'BASE TIME SLICE FOR PQ', I1,
     1	' (IN MILLISECONDS) ', $)
	READ (INU, *) 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 (OUTU, 97)
   97	FORMAT (X, 'NOW ATTEMPTING TO READ IN BASE 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 (OUTU, 95) I1, D(1), I2, D(2)
   95	FORMAT (/,X, 'BASE 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, INU, OUTU
	DIMENSION D(0:512)
*
*		READ/SET DESIRED CHANNEL USAGE FUNCTION
*
	WRITE (OUTU, 99)
   99	FORMAT (X, 'CHANNEL UTILIZATION IS A HISTORICAL FUNCTION',
     1      ' NO LONGER IMPLEMENTED')
	RETURN
	END

	SUBROUTINE FUN5
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READ/SET EACH JOB'S CLASS
*
	IF (W .EQ. 1) GOTO 200
   50	WRITE (OUTU, 99) Z
   99	FORMAT (X, 'HIGHEST JOB (1-', I4, ') ', $)
	READ (INU, *) 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 (OUTU, 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 (OUTU, 96)
   96	FORMAT(//,X, '(-1 MEANS QUIT, 0 MEANS YOURSELF) ', $)
  230	WRITE (OUTU, 94)
   94	FORMAT (//, X, 'WHICH JOB ', $)
	READ (INU, *) 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 (OUTU, 95) HCL
   95	FORMAT (X, 'WHICH CLASS (0-', I2, ') ', $)
	READ (INU, *) 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, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READ/SET PROT0 (CONSTANT ADDED TO MCU)
*		MEASURED IN MICROSECONDS
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
	WRITE (OUTU, 99)
   99	FORMAT (X, 'NEW VALUE FOR PROT0 (IN MICROSECONDS) ', $)
	READ (INU, *) D(0)
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (OUTU, 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, INU, OUTU
	DIMENSION D(0:512)
*
*		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 (OUTU, 99) HCL
   99	FORMAT (X, 'HIGHEST CLASS (0- ', I2, ') ', $)
	READ (INU, *) 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 (OUTU, 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, INU, OUTU
	DIMENSION D(0:512)
*
*		READ/SET EXPONENTIAL FACTOR (IE DEPENDANCE ON THE PAST)
*		IN THE RANGE 0-10000
*
	WRITE (OUTU, 99)
   99	FORMAT (X, 'EXPONENTIAL FACTOR IS A HISTORICAL FUNCTION',
     1      ' NO LONGER IMPLEMENTED')
	RETURN
	END

	SUBROUTINE FUN9
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READ/SET VALUE OF PROT (MCU MULTIPLIER)
*		MEASURED IN MICROSECONDS
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
	WRITE (OUTU, 99)
   99	FORMAT (X, 'NEW VALUE FOR PROT (IN MICROSECONDS) ', $)
	READ (INU, *) D(0)
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (OUTU, 97) D(0)
   97	FORMAT (X, 'NEW VALUE OF PROT IS ', I8, ' MICROSECONDS')
	RETURN
	END

	SUBROUTINE FUN10
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READ/SET VALUE OF DEFCLS (DEFAULT CLASS)
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
	WRITE (OUTU, 99)
   99	FORMAT (X, 'NEW VALUE FOR DEFAULT CLASS ', $)
	READ (INU, *) D(0)
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (OUTU, 97) D(0)
   97	FORMAT (X, 'NEW DEFAULT CLASS IS', I4)
	RETURN
	END

	SUBROUTINE FUN11
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READ/SET PROT1 (MCU CONSTANT USED ON REQUEUE)
*		MEASURED IN MICROSECONDS
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
	WRITE (OUTU, 99)
   99	FORMAT (X, 'NEW VALUE FOR PROT1 (IN MICROSECONDS) ', $)
	READ (INU, *) D(0)
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (OUTU, 97) D(0)
   97	FORMAT (X, 'NEW VALUE OF PROT1 IS', I8, ' MICROSECONDS')
	RETURN
	END

	SUBROUTINE FUN12
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READ/SET VALUE OF PROTM (MCU MAXIMUM)
*		MEASURED IN MICROSECONDS
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
	WRITE (OUTU, 99)
   99	FORMAT (X, 'NEW VALUE FOR PROTM (IN MICROSECONDS) ', $)
	READ (INU, *) D(0)
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (OUTU, 97) D(0)
   97	FORMAT (X, 'NEW VALUE OF PROTM IS ', I8, ' MICROSECONDS')
	RETURN
	END

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

	SUBROUTINE FUN14
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READ/SET TIME SLICE MAXIMA FOR THE TWO QUEUES.
*		MEASURED IN MILLISECONDS
*
	IF (W .EQ. 0) GOTO 200
  100	WRITE (OUTU, 99)
   99	FORMAT (X, 'CHANGE TIME SLICE MAXIMUM OF WHICH PQ (1-2) ', $)
	READ (INU, *) PVAL
	IF (PVAL .EQ. -1) RETURN
	IF ( PVAL .LT. 1) GOTO 100
	IF ( PVAL .GT. 2) GOTO 100
  105	WRITE (OUTU, 98) PVAL
   98	FORMAT (X, 'TIME SLICE MAXIMUM FOR PQ', I1,
     1      ' (IN MILLISECONDS) ', $)
	READ (INU, *) 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 (OUTU, 97)
   97	FORMAT (X, 'NOW ATTEMPTING TO READ IN TIME SLICE MAXIMA')
  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 (OUTU, 95) I1, D(1), I2, D(2)
   95	FORMAT (/,X, 'TIME SLICE MAXIMUM FOR PQ', I1, ' IS NOW ', I8,
     1	' MILLISECONDS.')
	RETURN
	END

	SUBROUTINE FUN15
*
*		READ/SET SECONDARY ALLOCATIONS
*		(IE THE RELATIVE AMOUNT OF LEAVINGS A CLASS CAN HAVE)
*
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
	GOTO (100,101) W+1
*
  100	WRITE (OUTU, 99) HCL
   99	FORMAT (X, 'HIGHEST CLASS (0-', I2, ') ', $)
	READ (INU, *) 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
  120	WRITE (OUTU, 97) I1, D(I)
   97	FORMAT (X, 'CLASS:',I2,'  SECONDARY ALLOCATION:',I5)
	RETURN
*
  101	TOPCLS = 0
	WRITE (OUTU, 96) HCL
   96	FORMAT (X, 'GIVE CLASS NUMBER (0-', I2,
     1	 ') AND THEN THE SECONDARY ALLOCATION (0-1000) ',
     2	/, 5X, '(-1 TO EXIT)')
  150	WRITE (OUTU, 95)
   95	FORMAT (/,X,'CLASS: ', $)
	READ (INU, *) CVAL
	IF (CVAL .EQ. -1) GOTO 200
	IF (CVAL .LT. 0) GOTO 150
	IF (CVAL .GT. HCL) GOTO 150
  155	WRITE (OUTU, 93)
   93	FORMAT (X, 'SECONDARY ALLOCATION: ', $)
	READ (INU, *) PVAL
	IF (PVAL .EQ. -1) GOTO 200
	IF (PVAL .LT. 0) GOTO 155
	IF (PVAL .GT. 10000) GOTO 155
	IF (TOPCLS .LT. 128) TOPCLS = TOPCLS + 1
	D(TOPCLS) = CVAL*"1000000 .OR. PVAL
	GOTO 150
200	IF (TOPCLS .EQ. 0) RETURN
	D(0) = TOPCLS
	CALL SCDEXE
	CALL ERRCON
	RETURN
	END

	SUBROUTINE FUN16
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READ/SET SCDJIL (RESPONSE FAIRNESS PERCENTAGE)
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
	WRITE (OUTU, 99)
   99	FORMAT (X, 
     1	'NEW PERCENTAGE FOR RESPONSE FAIRNESS FACTOR (1-100) ', $)
	READ (INU, *) D(0)
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (OUTU, 97) D(0)
   97	FORMAT (X, 'RESPONSE FAIRNESS FACTOR IS NOW', I4, '%')
	RETURN
	END

	SUBROUTINE FUN17
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READ/SET SWAP TIME ESTIMATE
*		MEASURED IN JIFFIES
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
	WRITE (OUTU, 99)
   99	FORMAT (X, 'NEW SWAP TIME ESTIMATE (IN JIFFIES) ', $)
	READ (INU, *) D(0)
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (OUTU, 97) D(0)
   97	FORMAT (X, 'AVG SWAP TIME ESTIMATE IS NOW', I4, ' JIFFIES')
	RETURN
	END

	SUBROUTINE FUN18
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READ/SET BACKGROUND BATCH CLASS
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
	WRITE (OUTU, 99)
   99	FORMAT (X, 'NEW BACKGROUND BATCH CLASS (-1 FOR NONE) ', $)
	READ (INU, *) D(0)
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (OUTU, 97) D(0)
   97	FORMAT (X, 'BACKGROUND BATCH IS NOW CLASS', I4)
	RETURN
	END

	SUBROUTINE FUN19
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READ/SET BACKGROUND BATCH SWAP TIME
*		MEASURED IN JIFFIES
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
	WRITE (OUTU, 99)
   99	FORMAT (X,
     1	  'NEW BACKGROUND BATCH SWAP INTERVAL (IN JIFFIES) ', $)
	READ (INU, *) D(0)
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (OUTU, 97) D(0)
   97	FORMAT (X, 
     1	'BACKGROUND BATCH SWAP INTERVAL IS NOW', I8, ' JIFFIES')
	RETURN
	END
	SUBROUTINE FUN20
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READ/SET SCHEDULER FAIRNESS FACTOR
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
	WRITE (OUTU, 99)
   99	FORMAT (X, 
     1	'NEW SCHEDULER FAIRNESS FACTOR (1-1000) ', $)
	READ (INU, *) D(0)
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (OUTU, 97) D(0)
   97	FORMAT (X, 'SCHEDULER FAIRNESS FACTOR IS NOW', I5)
	RETURN
	END

	SUBROUTINE FUN21
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READ/SET SWAPPER FAIRNESS FACTOR
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
	WRITE (OUTU, 99)
   99	FORMAT (X, 
     1	'NEW SWAPPER FAIRNESS FACTOR (1-1000) ', $)
	READ (INU, *) D(0)
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (OUTU, 97) D(0)
   97	FORMAT (X, 'SWAPPER FAIRNESS FACTOR IS NOW', I5)
	RETURN
	END

	SUBROUTINE FUN22
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READ/SET INCORE FAIRNESS FACTOR FOR SWAP IN
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
	WRITE (OUTU, 99)
   99	FORMAT (X, 
     1	'NEW PERCENTAGE FOR INCORE FAIRNESS FACTOR (0-100) ', $)
	READ (INU, *) D(0)
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (OUTU, 97) D(0)
   97	FORMAT (X, 'INCORE FAIRNESS FACTOR IS NOW', I4, '%')
	RETURN
	END

	SUBROUTINE FUN23
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READ/SET CORE SCHEDULING INTERVAL FOR DEMAND SCHEDULING OF CORE
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
	WRITE (OUTU, 99)
   99	FORMAT (X, 
     1	'NEW CORE SCHEDULING INTERVAL (IN SECONDS) ', $)
	READ (INU, *) D(0)
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (OUTU, 97) D(0)
   97	FORMAT (X, 'CORE SCHEDULING INTERVAL IS NOW', I5, ' SECONDS')
	RETURN
	END
	SUBROUTINE FUN24
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READS OR SETS THE SCHEDULER QUEUE SCAN ORDER
*
	D(0) = 1
	IF (W .EQ. 0) GOTO 100
	WRITE (OUTU, 99)
   99	FORMAT (X, 
     1	'FOR QUEUE SCAN ORDER, ANSWER 0 FOR (PQ1,PQ2), 1 FOR (PQ2,PQ1)'/
     1	' ENTER CPU NUMBER, QUEUE SCAN ORDER ', $)
	READ (INU, *) I,J
	D(1) = "1000000*I + J
	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	RETURN
  100	I = A
	A = "134000011
*
*	GET NUMBER OF CPUS
*
	CALL TABGET
	IF (B .NE. 0) GOTO 300
	D(0) = A
	A = I
	CALL SCDEXE
	IF (B .NE. 0) GOTO 300
	A = D(0) - 1
	DO 200 I = 0, A
	WRITE (OUTU, 98) I
  98	FORMAT(X, 'ON CPU',I1, ', THE QUEUE SCAN ORDER IS '$)
	IF (D(I+1) .EQ. 0) WRITE (OUTU, 97)
  97	FORMAT(X,'(PQ1,PQ2)')
	IF (D(I+1) .EQ. 1) WRITE (OUTU, 96)
  96	FORMAT(X,'(PQ2,PQ1)')
  200	CONTINUE
  300	CALL ERRCON
	RETURN
	END
	SUBROUTINE FUN25
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READS OR SETS THE HIGH SEGMENT RETENTION TIME
*		(THE TIME WHICH A DORMANT OR IDLE HIGH SEGMENT WILL 
*		STAY AROUND BEFORE IT IS DELETED) THE MEASUREMENT IS
*		IN JIFFIES.
*
	D(0) = 0
	IF (W .EQ. 0) GOTO 100
  101	WRITE (OUTU, 99)
   99	FORMAT(X, 'NEW VALUE FOR THE HIGH SEGMENT RETENTION TIME:',
     1	' (IN JIFFIES) ', $)
	READ (INU, *) 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 (OUTU, 97) D(0)
   97	FORMAT (X, 'HIGH SEGMENT RETENTION TIME NOW =', I8, ' JIFFIES')
	RETURN
	END

	SUBROUTINE FUN26
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		READS OR SETS THE PERCENTAGE OF USER CORE WHICH THE SWAPPER
*		TRIES TO KEEP FREE BY SWAPPING OUT JOBS WHICH ARE IN LONG
*		TERM WAIT.
*
	D(0) = 1
	IF (W .EQ. 0) GOTO 100
  101	WRITE (OUTU, 99)
   99	FORMAT(X, 'NEW VALUE FOR THE FREE CORE GOAL:',
     1	' (PERCENT OF USER CORE) ', $)
	READ (INU, *) D (0)
	IF ( D(0) .LT. 0) RETURN
	IF ( D(0) .GT. 10000) RETURN
	WRITE (OUTU, 98)
   98	FORMAT(X, 'NEW VALUE FOR THE FREE CORE LIMIT:',
     1	' (PERCENT OF USER CORE) ', $)
	READ (INU, *) D (1)
  100	CALL SCDEXE
	CALL ERRCON
	IF (B .NE. 0) RETURN
	WRITE (OUTU, 97) D(0),D(1)
   97	FORMAT (X, 'FREE CORE GOAL NOW =', I8, ' (PERCENT OF USER CORE)',
     1 /X, 'FREE CORE LIMIT NOW =', I8, ' (PERCENT OF USER CORE)')
	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
*
	COMMON ADUM, BDUM, DDUM, WDUM, ZDUM, HCLDUM, INU, OUTU
	DIMENSION DDUM(0:512)
	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/' ',',    '/
*
	CALL TTYMOD		!RETURN TO CONVERSATIONAL MODE
	DO 10 I=1,NOFUNS
	  DECODE (FUNLEN,9999,CLIST(1,I))(CLISTA(J,I),J=1,FUNLEN)
   10	CONTINUE
 9999	FORMAT (80A1)
*
	WRITE (OUTU, 99)
   99	FORMAT (//,X,'MAKMAP SUBFUCTION: MANIPULATE A SCDMAP.SYS FILE',
     1	/, 5X,  'TYPE HELP FOR HELP')
  100	WRITE (OUTU, 98)
   98	FORMAT (/, X, '(MAKMAP LEVEL)', /, X, 'WHAT FUNCTION ', $)
	READ (INU,196) (SRCSTR(I),I=1,80)
  196	FORMAT (80A1)
	CALL MAPCSE(SRCSTR,80)
	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 (OUTU, 86)
   86	FORMAT (X, 'WHICH MAP (0=TIMESHARE, 1=BATCH) ', $)
	READ (INU,*) 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 (OUTU, 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 (OUTU,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 (OUTU, 96)
   96	FORMAT (/, X, 'INPUT COMPLETE, FILE CLOSED',/)
	GOTO 100
10003	WRITE (OUTU, 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 (OUTU, 95)
   95	FORMAT (/, X, 'OUTPUT COMPLETE, FILE CLOSED', /)
	GOTO 100
10013	WRITE (OUTU, 87)
   87	FORMAT (X, 'ERROR ON OUTPUT FILE')
	CLOSE (UNIT=20)
	GOTO 100
**************************************************
**************************************************
*		CHANGE A RANGE OF SCD TYPES TO A CLASS
*
10020	WRITE (OUTU, 94)
   94	FORMAT (X, 'WHAT RANGE (SEPARATE BY COMMAS) (0,511) ', $)
	READ (INU, *) 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 (OUTU, 93) R1, R2
   93	FORMAT (X, 'SAME CLASS FOR ', I3, ' THRU ', I3, ' (1=YES) ', $)
	READ (INU, *) YESNO
	IF (YESNO .NE. 1) YESNO = 0
	DO 10022 I=R1, R2
	IF ((I .GT. R1) .AND. (YESNO .EQ. 1)) GOTO 10022
	WRITE (OUTU, 92) I
   92	FORMAT (X, 'TYPE: ', I3, '  CLASS: ', $)
	READ (INU, *) CLASS
10022	M(I + (TB*512)) = CLASS
	GOTO 100
**************************************************
*		CHANGE ONE SCD TYPE TO A CLASS
*
10030	WRITE (OUTU, 91)
   91	FORMAT (X, 'GIVE TYPE AND CLASS SEPARATED BY COMMAS ', $)
	READ (INU, *) 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 (OUTU, 90)
   90	FORMAT (X, 'WHAT RANGE (SEPARATE BY COMMAS) (0,511) ', $)
	READ (INU, *) 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 (OUTU, 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, HCL, INU, OUTU
	DIMENSION D(0:512), M(0:1023), M1(0:255)
*
	WRITE (OUTU, 97)
   97	FORMAT (X, 'DO YOU WISH TO MOVE A SCDMAP.SYS FILE TO SYS:',
     1	' (1=YES) ', $)
	READ (INU, *) 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
	TB = 0				!DEFAULT TO NOT BATCH
	IF (B .NE. 0) GOTO 150		!GETTAB FAILED??
	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 (OUTU, 98) I
   98	FORMAT (/, X, 'SCHED. UUO FAILED FOR JOB ', I4)
	CALL ERRCON			!TELL HIM THE ERROR
  200	CONTINUE
	WRITE (OUTU, 99)
   99	FORMAT (//, X, 'ALL OTHER JOBS DONE.')
	RETURN
	END

	SUBROUTINE SCANAC
	IMPLICIT INTEGER (A-Z)
	PARAMETER CLSWRD=19		!WORD NUMBER OF CLASS STUFF
	PARAMETER AEMAX=208		!SIZE OF PROFILE
	PARAMETER AEPPN=1		!WORD NUMBER OF PPN IN PROFILE
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
*
*		CALL PROGET TO GET USER PROFILE OF THIS PPN
*		TAKES PPN IN A,  RETURNS SCD TYPE IN A
*
	CALL PROGET			!GO ASK ACTDAE FOR USER PROFILE
	IF (B .NE. 0) GOTO 100     	!GO DECODE ERROR IF NEED BE
	B = D(0)			!GET VERSION AND LENGTH WORD
	ACTSIZ = B .AND. "777777	!SIZE OF EACH ENTRY
	IF (ACTSIZ .NE. AEMAX) GOTO 998	!CLEARLY IMPOSSIBLE
	IF (CLSWRD .GT. ACTSIZ) GOTO 998
	B = B .AND. "777777000000	!MASK OFF BORING STUFF
	IF (B .NE. "5000000) GOTO 998	!RIGHT VERSION OF ACCT.SYS?
	B = 0				!CLEAR ERROR FLAG
	A = (D(CLSWRD) .AND. "777000) / "1000	!EXTRACT SCHED CLASS
	RETURN
*
*HERE TO DECODE ERROR RETURNED BY ACTDAE IN REPSONSE BLOCK
*
  100	B = D(0) * "10000000		!GET 3 CHAR SUFFIX LEFT JUSTIFIED
	IF (B .NE. 'NP') GOTO 115 	!IF NO SUCH PPN FALL THRU
  105   WRITE (OUTU, 110) A
  110	FORMAT (X, 'USER ', O12, ' NOT IN ACTDAE.SYS')
	B=1; A=0			!HE WASN'T IN ACCT.SYS
	RETURN

  115	WRITE (OUTU, 120) A,D		!UNEXPECTED ERROR
  120	FORMAT (X, 'ERROR WHILE GETTING PROFILE FOR ',O12, ':',/,10A5)
	STOP

  998	WRITE (OUTU, 89)
   89	FORMAT (X, 'WRONG VERSION OF ACTDAE.SYS')
	STOP
	END
	SUBROUTINE MOVSCD
	IMPLICIT INTEGER (A-Z)
	COMMON A, B, D, W, Z, HCL, INU, OUTU
	DIMENSION D(0:512)
	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.
*
	CALL TTYMOD		!RETURN TO CONVERSATIONAL MODE
	WRITE (OUTU, 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 (OUTU, 99)
   99	FORMAT (X, 'FILE SUCCESSFULLY READ IN.')
	OPEN (UNIT=20, ACCESS='SEQOUT', MODE='DUMP', DEVICE='SYS',
     1	FILE='SCDMAP.SYS', DIALOG)
	WRITE (20, ERR=997) M
	CLOSE (UNIT=20)
	WRITE (OUTU, 98)
   98	FORMAT (X, 'FILE SUCCESSFULLY WRITTEN OUT.')
	CALL NEWSCD		!TELL ACTDAE TO REREAD SCDMAP.SYS
	IF (B .EQ. 0) RETURN
	WRITE (OUTU, 92) D
   92	FORMAT(X, 'ACTDAE COULD NOT REREAD SCDMAP.SYS, ERROR: ',/,10A5)
	RETURN
  999	WRITE (OUTU, 96)
   96	FORMAT (X, 'REACHED END OF FILE TOO SOON.')
	CLOSE (UNIT=20)
	RETURN
  998	WRITE (OUTU, 95)
   95	FORMAT (X, 'ERROR IN READING FILE.')
	CLOSE (UNIT=20)
	RETURN
  997	WRITE (OUTU, 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+1
20	  J = J-1		
	  IF (SRC(J) .NE. BLANK .AND.
     1      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