From:	CSBVAX::CSBVAX::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 20-JAN-1989 23:24
To:	MRGATE::"ARISIA::EVERHART"
Subj:	long term scheduler - part 3 of 5


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Thu, 19 JAN 89 20:26:43 PDT
Received: from RELAY.CS.NET by KL.SRI.COM with TCP; Thu, 19 Jan 89 20:23:30 PST
Received: from relay2.cs.net by RELAY.CS.NET id av21989; 19 Jan 89 20:43 EST
Received: from a.cs.okstate.edu by RELAY.CS.NET id ac18099; 19 Jan 89 19:25 EST
Received: from nemo.math.okstate.edu by a.cs.okstate.edu id aa10453;
          19 Jan 89 9:47 CST
Date: Thu, 19 Jan 89 09:38 CDT
From: Gregg Wonderly <GREGG%nemo.math.okstate.edu@RELAY.CS.NET>
Subject: long term scheduler - part 3 of 5
To: info-vax@KL.SRI.COM
X-VMS-To: in%"info-vax@kl.sri.com"

$Part3:
$ File_is="SCHED.FOR"
$ Check_Sum_is=611945442
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X******************************************************************************
X*
X*                                S C H E D
X*
X*       Author:     Gregg Wonderly
X*       Where:      Department of Mathematics
X*                   Oklahoma State University
X*       When:       Apr-10-1987
X*       Version:    0.0 - 10
X*
X*           This program is an attempt to alter the typical behavior of the
X*       VMS process scheduler.  It's primary function is to detect CPU bound
X*       processes, and adjust their priority down while they are consuming
X*       CPU.  This program works best when the priority structure of the
X*       processes on the system result in a single priority 1 level below
X*       interactive priority is not used by any processes.  e.g.  If your
X*       system is layed out as follows, then you will have the most consistant
X*       performance.
X*
X*           Priority                Type of processes
X*           --------                -----------------
X*               1                   Large batch jobs
X*               2                   Medium batch jobs
X*               3                   Small batch jobs or not used
X*               4                   Interactive priority or not used
V*               5                   Possible interactive priority if 3 is used
X.
X*
X*       With this layout, batch jobs will not compete directly for the same
X*       priority CPU useage as interactive CPU bound processes.
X*
V******************************************************************************
X*
X
X        implicit none
X
X        include '($ssdef)'
X        include 'gdata.inc'
X        include 'statedef.inc'
X
X        logical done, get_proc_info, found, adjust_proc
X
X        integer i, j, avidx, avail(0:MAX_PROCS), newcnt, nprocs
X        integer usedtime, getsysgrp, stat, get_mbx, defprot
X        integer allowed, needed, max, k
X        integer mbx_chan, del_mbx, readdone
X        integer cpumax, maxidx, usedpercent
X        integer msgvec(1:2)
X
X        external get_proc_info, sleep, getsysgrp, get_mbx
X        external del_mbx, ast_enable, ast_disable, sys$putmsg
X        external readdone, sys$exit, SCHED__EXITED
X        external SCHED__NOTSTOPPED
X
X*       Check to see if one is already running.
X
X        i = 3
X        do while (sch_running .and. (i .gt. 0))
X            call lib$signal (%val (%loc (SCHED__NOTSTOPPED)))
X            stopnow = .true.
X            call sleep (interval)
X            i = i - 1
X        end do
X
X*
X*       These values are stored in a shared, writeable global section, and
X*       must be initialized before execution begins
X*
X        max_percent = DEFAULT_MAX
X        min_percent = DEFAULT_MIN
X        up_prio     = DEFAULT_UP_PRIO
X        down_prio   = DEFAULT_DOWN_PRIO
X        io_diff     = DEFAULT_IO_DIFFERENCE
X        interval    = DEFAULT_INTERVAL
X        min_time    = DEFAULT_MIN_TIME
X        down_count  = DEFAULT_DOWNCNT
X        hog_count   = DEFAULT_HOGCOUNT
X        hog_prio    = DEFAULT_HOGPRIO
X        idle_cnt    = DEFAULT_IDLECNT
X        max_active   = DEFAULT_MAXACTIVE
X
X        sysgrp      = -1
X        stopnow     = .false.
X        sch_running = .true.
X        queuecnt    = 0
X
X*       Clean out queues structure
X
X        do i=0, MAX_QUEUES
X            queues(i).used = .false.
X        end do
X
X*       Clean out process structure
X
X        do i=0, MAX_PROCS
X            prev(i).used = .false.
X        end do
X
X*       Delete any old mailboxes laying around.
X
X        stat = del_mbx (mbx_chan)
X
X*       Create a new mailbox with the appropriate protections
X        defprot = '0000ffcc'X
X        stat = get_mbx (mbx_chan, %val(defprot))
X
X*       Currently no process slots are in use
X
X        newcnt = 0
X        curcnt = 0
X
X*       Open a file to the load average pseudo device
X
X        open (unit=7, file='LAV0:', STATUS='OLD', err=7)
X7       continue
X
X*
X*       This is the processing loop.  We execute here forever...
X*
X        do while (.true.)
X
X*           Get the sysgroup value.
X
X            if (sysgrp .eq. -1) then
X                stat = getsysgrp (0)
X
X*               If the $getsyi fails, then use a predetermined value.  This
X*               should probably be regarded as a fatal error...  <sigh>
X
X                if ((stat .and. 1) .eq. 0) then
X                    print *,'Error getting MAXSYSGRP,',DEFSYSGRP,' assumed'
X                    sysgrp = DEFSYSGRP
X                endif
X            endif
X
X*           Reset the PID wildcard for the $getjpi call.
X
X            pids = -1
X            done = .false.
X            i = 0
X
X*           Collect all of the current processes to be considered
X
X            do while (.not. done)
X                done = get_proc_info (procs(i))
X                if (.not. done) then
X                    i = i + 1
X                    if (i .gt. MAX_PROCS) done = .true.
X                endif
X            end do 
X
X*           Set up to process the information
X
X            nprocs = i - 1
X            avidx = 0
X            sumtime = 0
X
X*           Look at each process, one at a time.
X
X            cpumax = -1
X            maxidx = -1
X
X            do i=0,nprocs
X
X*               We must now search the previous process information list to
X*               determine whether this is a new process, or an old process.
X*               After this has been done for all newly collected processes,
X*               the we will be able to determine whether or not a process has
X*               become non-considered (i.e. it has been deleted, or has enable
X*               the proper priviledges, etc.).
X
X                newcnt = 0
X                j = 0
X                found = .false.
X
X*               Only look as far as we have placed processes in the table.
X
X                do while ((j .ne. curcnt) .and. (.not. found))
X
X                    if (DEBUG) print *,'Idx:',j,', Used =',prev(j).used
X
X*                   If this slot is used then see if the pid matches
X
X                    if (prev(j).used) then
X
X*                       Save pid of highest used place
X
X                        newcnt = max (j, newcnt)
X
X*                       Check for same pid.
X
X                        if (procs(i).pid .eq. prev(j).pid) then
X
X*                           Compute elasped CPU time for this quantum.
X
X                            usedtime = (procs(i).cputim - prev(j).cputim)
X                            prev(j).cpuused = usedtime
X
X                            if (usedtime .gt. cpumax) then
X                                cpumax = usedtime
X                                maxidx = j
X                            endif
X
X                            if (DEBUG) print *,'pid: ',procs(i).pid,
X     .                              ', used time: ', usedtime
X
X*                           Compute total used CPU time used by all
X*                           considered processes.
X
X                            sumtime = sumtime + usedtime
X
X*                           Update the current data
X
X                            prev(j).newimage = 
X     .                              (prev(j).imagecnt .ne. procs(i).imagecnt)
X
X*                           Copy in other information
X
X                            call update (i, j)
X                            found = .true.
X
X*                           Say that the info was updated.  All entries with
V*                           prev(j).upd = .false. will no longer be considered
X.
X
X                            prev(j).upd = .true.
X                        endif
X                    else
X                        if (DEBUG) print *,'New avail',j
X
X*                       Add the unused slot to the available list
X
X                        avail(avidx) = j
X                        avidx = avidx + 1
X                        prev(j).upd = .false.
X                    endif
X
X*                   Next process slot
X
X                    j = j + 1
X                end do
X
V*               If .not. found then this is a new process, so add it to the li
Xst
X
X                if ( .not. found ) then
X
X*                   If no empty slots are available then add to end and extend
X
X                    if (avidx .eq. 0) then
X                        j = curcnt
X                        curcnt = curcnt + 1
X                    else
X
X*                       Otherwise use the last available slot.
X
X                        if (curcnt .gt. newcnt+1) then
X                            curcnt = newcnt + 1
X                            if (DEBUG) print *,
X     .                                  'Changing curcnt to ', curcnt
X                        endif
X
X                        j = avail(avidx-1)
X                        avidx = avidx - 1
X                        if (DEBUG) print *,'Used avail: ',j,
X     .                                          ' New avidx:',avidx
X                    endif
X
X*                   Initialize the new processes information.
X
X                    call update (i, j)
X
X                    prev(j).strategy = SCH$NOSTRAT
X                    prev(j).activecnt = max_active
X                    prev(j).cpuused = 0
X                    prev(j).upd = .true.
X                    prev(j).used = .true.
X                    prev(j).adj = .false.
X                    prev(j).hog = .false.
X                    prev(j).idlecnt = 0
X                    prev(j).downcnt = -1
X                endif 
X            end do
X
X            if (STATS) then
X                print 9, allowed
X                write (6, 11)
X                write (6, 12)
X            endif
X
X*           Make sure that curcnt is as small as possible to reduce the
X*           processing time in the loops using it as a parameter.
X
X            curcnt = min (curcnt, MAX_PROCS)
X
X*           Now check all the considered processes to determine whether
X*           or not they should be considered.
X
X            do i=0, curcnt-1
X
X*               Only updated processes are still being considered.
X
X                if (prev(i).upd) then
X                    prev(i).upd = .false.
X
X                    if (DEBUG) print *,'Testing for strategy change ',
V     .                                                          prev(i).strate
Xgy
X
X                    if ((prev(i).strategy .ne. SCH$RESTART) .and.
X     .                          (prev(i).strategy .ne. SCH$NOSTRAT)) then
X
X                        prev(i).adj = .false.
X                        prev(i).hog = .false.
X
X                        if ((prev(i).strategy .eq. SCH$SMASH) .and.
X     .                                          (prev(i).bias .ne. 0)) then
X                            if (DEBUG) then
X                                print *,'Strategy changed to',prev(i).strategy
X                            endif
X
X                            if (adjust_proc (prev(i).pid, prev(i).bias)) then
X                                prev(i).bias = 0
X                            else
X                                prev(i).used = .false.
X                            endif
X                        else if (prev(i).strategy .eq. SCH$NEWIMAGE) then
X                            if (prev(i).bias .ne. 0) then
X                                if (adjust_proc (prev(i).pid,
V     .                                                      prev(i).bias)) the
Xn
X                                    prev(i).bias = 0
X                                else
X                                    prev(i).used = .false.
X                                endif
X                            else if (prev(i).newimage) then
X                                if (adjust_proc (prev(i).pid, up_prio)) then
X                                    prev(i).strategy = SCH$NOSTRAT
X                                    prev(i).activecnt = max_active
X                                    prev(i).cpuused = 0
X                                    prev(i).idlecnt = 0
X                                    prev(i).downcnt = -1
X
X*                                   Eligable process, so analyze it.
X
X                                    goto 100
X                                else
X                                    prev(i).used = .false.
X                                endif
X                            endif
X                        else
X
X*                           If strategy is not NEWIMAGE then it is IGNORE
X
X                            if (prev(i).bias .ne. 0) then
X                                if (adjust_proc (prev(i).pid, up_prio)) then
X                                    prev(i).bias = 0
X                                else
X                                    prev(i).used = .false.
X                                endif
X                            endif
X                        endif
X
X*                       Do no further processing of this process.
X
X                        goto 1000
X                    else if (prev(i).strategy .eq. SCH$RESTART) then
X                        if (adjust_proc (prev(i).pid, up_prio)) then
X                            prev(j).strategy = SCH$NOSTRAT
X                            prev(j).activecnt = max_active
X                            prev(j).cpuused = 0
X                            prev(j).adj = .false.
X                            prev(j).hog = .false.
X                            prev(j).idlecnt = 0
X                            prev(j).downcnt = -1
X                        else
X                            prev(i).used = .false.
X                        endif
X                    endif
X
X100                 continue
X
X*                   Calculate the maximum allowable CPU time, and the minimum
X*                   needed by a down graded process.
X
X                    allowed = interval*100*(max_percent/100.0)
X                    needed = interval*100*(min_percent/100.0)
X
X*                   There are lots of different heuristics that can be applied
X*                   at this point to determine what to do about any one
X*                   process's use of the CPU.  The following is a summary of
X*                   those applied here.
X*
X*                   A process using > allowed CPU will be downgraded to
X*                   down_prio, unless one or more of the following is true.
X*
X*                       o   It has initiated a new image since it was last
X*                           considered.
X*
X*                       o   The difference between its base and current
X*                           priority is >= to io_diff.
X*
X*                       o   It is already downgraded.
X*
X*                   A process using < needed CPU or one that has initiated
X*                   a new image will be upgraded to up_prio unless one or
X*                   or more of the following is true.
X*
X*                       o   It has not been downgraded for >= DEFAULT_DOWNCNT
X*                           intervals.
X*
X*                       o   It was not previously downgraded.
X*
X*                   DEFAULT_DOWNCNT is used to keep processes from thrashing
X*                   between priorities because of sporatic CPU utilization
X*                   of higher priority processes
X
X*                   Calculate percentage of time used.  SUMTIME is in
X*                   hundredths of a second, and interval is in seconds.
X*                   The division will therefore return the percentage as
X*                   an integer >= 0 and <= 100
X
X                    usedpercent = ifix (float (sumtime) / interval)
X
X                    if ((((prev(i).cpuused .gt. allowed) .and. 
X     .                   (.not. prev(i).newimage) .and.
V     .                   ((prev(i).curprio-prev(i).baseprio) .le. io_diff) .an
Xd.
X     .                   (.not. prev(i).adj)) .or.
X     .                   ((.not. prev(i).adj) .and. (usedpercent .gt. 95)
X     .                          .and. (i .eq. maxidx))) .and.
X     .                   (prev(i).baseprio .eq. up_prio)) then 
X
X                        if (prev(i).activecnt.eq.0) then
X                            prev(i).downcnt = prev(i).downcnt + 1
X
X                            if (adjust_proc (prev(i).pid, down_prio)) then
X                                prev(i).adj = .true.
X                                prev(i).idlecnt = 0
X                            else
X                                prev(i).used = .false.
X                            endif
X                        else
X                            prev(i).activecnt = prev(i).activecnt - 1
X                        endif
X                    else if (prev(i).adj .and. (prev(i).newimage .or.
X     .                        ((prev(i).state .ne. SCH$C_COM) .and.
X     .                        (prev(i).state .ne. SCH$C_CUR) .and.
X     .                       (prev(i).cpuused .lt. needed)))) then
X
X                        if (adjust_proc (prev(i).pid, up_prio)) then
X                            prev(i).adj = .false.
X                            prev(i).hog = .false.
X                            prev(i).downcnt = 0
X                            prev(i).idlecnt = 0
X                            prev(i).activecnt = max_active
X                        else
X                            prev(i).used = .false.
X                        endif
X                    else if (prev(i).adj) then
X
X*                       Otherwise increment the downcount if it is downgraded.
X
X                        prev(i).downcnt = prev(i).downcnt + 1
X
X                        if (prev(i).cpuused .lt. needed) then
X                            prev(i).idlecnt = prev(i).idlecnt + 1
X
X                            if (prev(i).idlecnt .gt. idle_cnt) then
X                                prev(i).downcnt = prev(i).downcnt / 2
X                                if (prev(i).hog) then
V                                    if (adjust_proc (prev(i).pid, down_prio)) 
Xthen
X                                        prev(i).hog = .false.
X                                        prev(i).idlecnt = prev(i).idlecnt / 2
X                                    else
X                                        prev(i).used = .false.
X                                    endif
X                                else
V                                    if (adjust_proc (prev(i).pid, up_prio)) th
Xen
X                                        prev(i).hog = .false.
X                                        prev(i).adj = .false.
X                                        prev(i).downcnt = 0
X                                        prev(i).idlecnt = 0
X                                        prev(i).activecnt = 0
X                                    else
X                                        prev(i).used = .false.
X                                    endif
X                                endif
X                            endif
X                        else
X
X*                           Check for a hog, and snuff them if necessary.
X
X                            if ((hog_count .lt. prev(i).downcnt) .and.
X     .                                               (hog_count .gt. 0) .and.
X     .                                               (.not. prev(i).hog)) then
X                                if (adjust_proc (prev(i).pid, hog_prio)) then
X                                    prev(i).hog = .true.
X                                else
X                                    prev(i).used = .false.
X                                endif
X                            endif
X                        endif
X                    endif
X
X1000                continue
X
X                    if (STATS) print 10, prev(i).pid,
X     .                      prev(i).baseprio, prev(i).cpuused, prev(i).adj
X                else
X
X*                   For processes that must no long be considered, we must
X*                   make an attempt to upgrade their priority to account for
X*                   the case where a process might enable privileges to make
V*                   itself nolonger considered.  If this process is downgraded
X,
X*                   we must restore it to 'up_prio' priority.
X
X                    if (prev(i).adj) then
X
X*                       If it is adjusted, then change it to up_prio, and
X*                       say that it is nolonger adjusted.  If adjust_proc
X*                       returns .true., then the process is still active,
X*                       otherwise it has been deleted.
X
X                        prev(i).used = adjust_proc (prev(i).pid, up_prio)
X                        prev(i).adj = .false.
X                    else
X                        prev(i).used = .false.
X                    endif
X
X                    if (STATS) write (6,30) prev(i).pid, 
X     .                                              prev(i).adj, prev(i).used
X                endif
X            end do
X
X*           After examining the processes then check for pending mailbox
X*           commands.  Loop until the mailbox is empty.
X
X            do while ((readdone (0) .and. 1) .eq. 1)
X                if (DEBUG) then
X                    print *,'Did a queued mailbox request.'
X                endif
X            end do
X
X*           Enable unsolicted writes with AST completion on the mailbox.
X
X            call ast_enable (0)
X
X*           $SCHDWK a wakeup for later, and handle mailbox requests while
X*           waiting.
X
X            call sleep (interval)
X
X*           Disable the AST completion of unsolicited writes.
X
X            call ast_disable (0)
X
X*           If we are supposed to stop now, then restore all processes and
X*           queues to their previous states, delete the mailbox, and $EXIT
X
X            if (stopnow) then
X                call clear_all (0)
X                call clear_queues (0)
X                stat = del_mbx (mbx_chan)
X
X*               Clear flag in global section to say scheduler is not running.
X
X                sch_running = .false.
X                msgvec(1) = 1
X                msgvec(2) = %loc(SCHED__EXITED)
X                call sys$putmsg (msgvec)
X                call sys$exit (%val (SS$_NORMAL))
X            end if
X        end do
X
X*       Debug formats
X
X9       format (10x, 'Milliseconds allowed:', I5)
X10      format (1x,Z8, 8x, I1, 10x, I5, 9x, L2)
X11      format (1x, '   PID      Priority      CPU used    Adjusted')
X12      format (1x, '-------------------------------------------------')
X30      format (1x, 'PID:',Z8,' checked out, adj:', L2, ', Used:',L2)
X        end
X
X******************************************************************************
X*
X*       Unadjust all adjusted processes.  This subroutine changes all
X*       processes that are adjusted down in priority back up to
X*       up_prio.
X*
X******************************************************************************
X
X        subroutine clear_all (dummy)
X            implicit none
X            include 'gdata.inc'
X
X            integer i, stat, dummy, adjust_proc
X            external adjust_proc
X
X*           Look at all entries and unadjust those that are adjusted.
X
X            do i=0, curcnt-1
X                if (prev(i).adj) then
X                    stat = adjust_proc (prev(i).pid, up_prio)
X                    prev(i).adj = .false.
X                endif
X            end do
X        end
X
X******************************************************************************
X*
X*       Copy selected data from the new data into the info structure.
X*
X******************************************************************************
X
X        subroutine update (proc_idx, prev_idx)
X            implicit none
X
X            include 'gdata.inc'
X
X            integer proc_idx, prev_idx
X
X*           Copy some selected information
X
X            prev(prev_idx).curprio  = procs(proc_idx).curprio
X            prev(prev_idx).baseprio = procs(proc_idx).baseprio
X            prev(prev_idx).cputim   = procs(proc_idx).cputim
X            prev(prev_idx).pid      = procs(proc_idx).pid
X            prev(prev_idx).imagecnt = procs(proc_idx).imagecnt
X            prev(prev_idx).used     = .true.
X            prev(prev_idx).proc     = proc_idx
X            prev(prev_idx).username = procs(proc_idx).username
X            prev(prev_idx).state    = procs(proc_idx).state
X        end
X
V******************************************************************************
X*
X*
X*       Alter the priority of the process who's pid is passed to be 'which'
X*
V******************************************************************************
X*
X
X        logical function adjust_proc (pid, which)
X            include 'params.inc'
X            integer pid, which, stat, sys$setpri
X            external sys$setpri
X
X            if (DEBUG) print 10, pid, which
X10          format (' Changing: ', Z8, ' to ', I2)
X
X*           Set the priority to that requested.
X
X            stat = sys$setpri (pid, %val(0), %val(which), %val(0))
X
X*           If $SETPRI fails for any reason other than SS$_NONEXPR then
X*           print an error message in the log file.
X
X            if ((stat .and. 1) .eq. 0) then
X                if (stat .ne. SS$_NONEXPR) print *,'* $SETPRI ERROR',stat
X            endif
X
X*           Return true or false based on successful completion.
X
X            adjust_proc = ((stat .and. 1) .eq. 1)
X            return
X        end
X
X******************************************************************************
X*
X*       This subroutine release all queues from consideration.  It is called
X*       before the scheduler exits.
X*
X******************************************************************************
X
X        subroutine clear_queues (dummy)
X            implicit none
X
X            include 'gdata.inc'
X
X            integer i, dummy
X
X            i = 0
X
X*           Just look at all queues in the list, and restart those that
X*           are paused.
X
X            do while ((i .le. MAX_QUEUES) .and. (queuecnt .gt. 0))
X                if (queues(i).used) then
X                    if (queues(i).paused) then
X                        call start_queue (queues(i).queuename,
X     .                                                  queues(i).queuelen)
X                    endif
X                    queues(i).used = .false.
X                    queuecnt = queuecnt - 1
X                endif
X                i = i + 1
X            end do
X        end
X
V******************************************************************************
X*
X*
X*       This subroutine releases a queue from consideration of being paused
X*       because of load averages on the processor.  It is called from
X*       'readdone' in 'mbx.mar' after a mailbox request to release a queue has
X*       been made.
X*
V******************************************************************************
X*
X
X        subroutine release_queue (qname, qlen)
X            implicit none
X
X            include 'gdata.inc'
X
X            character qname(1:*)
X            integer i, qlen, j
X            logical done
X            external SCHED__NOSUCHQ, lib$signal
X
X            done = .false.
X            i = 0
X
X*           Search throught the list of queues.
X
X            do while ((i .le. MAX_QUEUES) .and. (.not. done))
X
X                if (queues(i).used) then
X
X*                   If names are same length the check for a match
X
X                    if (qlen .eq. queues(i).queuelen) then
X                        done = .false.
X                        j = 1
X
X*                       Compare the two names, if a match occurs, then
X*                       (j .gt. qlen) will be true.
X
X                        do while ((.not. done) .and. (j .le. qlen))
X                            if (queues(i).queuename(j) .ne. qname(j)) then
X                                done = .true.
X                            else
X                                j = j + 1
X                            endif
X                        end do
X
X                        done = .false.
X
X*                       If a match, then restart the queue.
X
X                        if (j .gt. qlen) then
X                            if (queues(i).paused) then
X                                call start_queue (queues(i).queuename,
X     .                                                  queues(i).queuelen)
X                            endif
X                            queues(i).used = .false.
X                            queuecnt = queuecnt - 1
X                            done = .true.
X                        endif
X                    endif
X                endif
X                i = i + 1
X            end do
X
X*           If the queue was not found in the list, then signal a
X*           warning with the queue name passed as a parameter to the
X*           text.
X
X            if (.not. done) then
X                call lib$signal (%val (%loc (SCHED__NOSUCHQ)), %val (2),
X     .                           %val (qlen), %ref (qname))
X            endif
X        end
X
X*****************************************************************************
X*
X*       This subroutine initiates consideration of a queue to be paused
X*       because of load averages on the processor.  It is called from
X*       'readdone' in 'mbx.mar' after a mailbox request to add a queue has
X*       been made.
X*
X*****************************************************************************
X
X        subroutine add_queue (qname, qlen, maxavg, minavg)
X            implicit none
X
X            include 'gdata.inc'
X
X            character qname(1:*)
X            integer i, j, k, qlen, avail(1:MAX_QUEUES), avidx
X            real maxavg(1:3), minavg(1:3)
X            external lib$signal, alarm, SCHED__NOQUEUES
X            logical done
X
X            done = .false.
X            i = 0
X            k = queuecnt
X            avidx = 0
X
X*           Look for an open slot in the list.
X
X            do while ((i .le. MAX_QUEUES) .and. (.not. done) .and. (k .gt. 0))
X                if (queues(i).used) then
X                    k = k - 1
X                    if (qlen .eq. queues(i).queuelen) then
X                        done = .false.
X                        j = 1
X
X                        do while ((.not. done) .and. (j .le. qlen))
X                            if (queues(i).queuename(j) .ne. qname(j)) then
X                                done = .true.
X                            else
X                                j = j + 1
X                            endif
X                        end do
X
X                        done = .false.
X
X                        if (j .gt. qlen) then
X                            do j=1, 3
X                                queues(i).maxavg(j) = maxavg(j)
X                                queues(i).minavg(j) = minavg(j)
X                            end do
X                            done = .true.
X                        endif
X                    endif
X                else
X                    avidx = avidx + 1
X                    avail(avidx) = i
X                endif
X                i = i + 1
X            end do
X
X*           If there was not already an entry for this queue, then
X*           add one.  If there was an available slot, then use that
X*           otherwise use the next one on the end.
X
X            if (.not. done) then
X                if (avidx .gt. 0) then
X                    i = avail(1)
X                endif
X
X*               Make sure we don't exceed the array bounds.
X
X                if (i .le. MAX_QUEUES) then
X
X*                   If we found one, then insert it here.
X
X                    queues(i).used = .true.
X                    queues(i).queuelen = qlen
X                    queues(i).paused = .false.
X
X                    do j=1, qlen
X                        queues(i).queuename(j) = qname(j)
X                    end do
X
X                    do j=1, 3
X                        queues(i).maxavg(j) = maxavg(j)
X                        queues(i).minavg(j) = minavg(j)
X                    end do
X                    done = .true.
X                endif
X            endif
X
X*           If the insert failed, then signal a warning
X
X            if (.not. done) then
X                call lib$signal (%val (%loc (SCHED__NOQUEUES)), %val(2),
X     .                           %val (qlen), %val( %loc (qname)))
X            else
X                queuecnt = queuecnt + 1
X                if (queuecnt .eq. 1) then
X                    call sched_alarm (0)
X                endif
X            endif
X        end
X
X******************************************************************************
X*
X*       As long as there is at least one queue being considered, this routine
X*       is scheduled to execute once every minute to survey the load averages,
X*       and to then decide whether or not a queue should be paused based on
X*       that information.
X*
X******************************************************************************
X
X        subroutine alarm (dummy)
X            implicit none
X            integer dummy
X
X            include 'gdata.inc'
X
X            integer i, k, j, stat
X            logical*1 min, max
X            real averages(3)
X            character buf(12)
X
X*           Make it possible to read the load averages as a string of
X*           12 characters in raw binary format
X
X            equivalence (buf, averages)
X
X            k = queuecnt
X            i = 0
X
X*           Read the load average information.
X
X            read (7, 10, err=100) buf
X10          format (12(A1))
X
X*           Cycle through all queues.
X
X            do while ((i .le. MAX_QUEUES) .and. (k .gt. 0))
X                if (queues(i).used) then
X
X                    min = .false.
X                    max = .false.
X
X                    do j = 1, 3
X                        if (averages(j) .gt. queues(i).maxavg(j)) then
X                            max = .true.
X                        else if (averages(j) .lt. queues(i).minavg(j)) then
X                            min = .true.
X                        endif
X                    end do
X
X*                   Now check min and max to determine whether or not the
X*                   queue should be paused.  min is true if at lease one
X*                   load average specified for a queue was below that of the
X*                   processor.  max is true if at least one load average
X*                   specified for the queue was above that of the processor.
X*                   When both min and max are true, max always has precedence
X*                   so that a queue is kept from restarting until all load
X*                   averages are below that of the system.
X
X                    if (max .and. (.not. queues(i).paused)) then
X                        call pause_queue (queues(i).queuename,
X     .                                                     queues(i).queuelen)
X                        queues(i).paused = .true.
V                    else if (min .and. (.not. max) .and. queues(i).paused) the
Xn
X                        call start_queue (queues(i).queuename,
X     .                                                     queues(i).queuelen)
X                        queues(i).paused = .false.
X                    endif
X
X*                   One less queue to consider
X
X                    k = k -1
X                endif
X
X*               One less entry in the list.
X
X                i = i + 1
X            end do
X
X            if (queuecnt .gt. 0) then
X                call sched_alarm (0)
X            endif
X            goto 200
X
X100         continue
X            if (queuecnt .gt. 0) then
X                call sched_alarm (0)
X            endif
X
X*           Try to open a file to the load average pseudo device, it was
X*           not available on a previous iteration.
X
X            close (unit=7, err=150)
X150         continue
X
X            open (unit=7, file='LAV0:', STATUS='OLD', err=200)
X
X200         continue
X        end
X
X******************************************************************************
X*
X*
X******************************************************************************
X
X        integer function find_proc (pid)
X            implicit none
X
X            include 'gdata.inc'
X
X            integer pid, rpid, i
X            rpid = 0
X
X            do i=0, curcnt-1
X                if (prev(i).used) then
X                    if (prev(i).pid .eq. pid) then
X                        rpid = %loc (prev (i))
X                    endif
X                endif
X            end do
X            find_proc = rpid
X        end
X
X******************************************************************************
X*
X*       This routine reschedules the $SETIMR AST completion routine for
X*       periodic check on load averages.  This must be a separate routine
X*       to get around the simple recursion check that the compiler makes.
X*
X******************************************************************************
X
X        subroutine sched_alarm (dummy)
X            implicit none
X            integer next(1:2), dummy, stat, sys$setimr
X            external sys$setimr, alarm
X
X            next (1) = -600000000
X            next (2) = -1
X            stat = sys$setimr (, next, alarm,)
X        end
X
X******************************************************************************
X*
X*       This routine does the actual $SNDJBC to pause the specified queue.
X*
X******************************************************************************
X
X        subroutine pause_queue (qname, len)
X            implicit none
X
X            include '($sjcdef)'
X
X            character qname(1:100)
X            integer sys$sndjbc, itmlst(1:10), len, stat
X            external sys$sndjbc, lib$signal
X
X            itmlst(1) = (65536 * SJC$_QUEUE) + len
X            itmlst(2) = %loc (qname)
X            itmlst(3) = 100
X            itmlst(4) = 0
X            itmlst(5) = 0
X            stat = sys$sndjbc (, %val (SJC$_PAUSE_QUEUE), ,itmlst,,,)
X            if ((stat.and.1).ne.1) then
X                call lib$signal(%val(stat))
X            endif
X        end
X
X******************************************************************************
X*
X*       This routine does the actual $SNDJBC to start the specified queue.
X*
X******************************************************************************
X
X        subroutine start_queue (qname, len)
X            implicit none
X
X            include '($sjcdef)'
X            character qname(1:100)
X            integer sys$sndjbc, itmlst(1:10), len, stat
X            external sys$sndjbc, lib$signal
X
X            itmlst(1) = (65536 * SJC$_QUEUE) + len
X            itmlst(2) = %loc (qname)
X            itmlst(3) = 100
X            itmlst(4) = 0
X            itmlst(5) = 0
X            stat = sys$sndjbc (, %val (SJC$_START_QUEUE), ,itmlst,,,)
X            if ((stat.and.1).ne.1) then
X                call lib$signal(%val(stat))
X            endif
X        end
$ GoSub Convert_File
$ File_is="SCHED_ERR.MSG"
$ Check_Sum_is=1634296064
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X`009.Title`009`009SCHED error messages
X`009.Facility`009SCHED,2/prefix=SCHED__
X`009.Ident`009`009'SCHED Version 1.0'
X
X`009.Severity`009informational
X`009EXITED`009`009<requested exit satisfied>
X`009CREATED`009`009<process id of created process is !8XL>
X`009NOTACTIVE`009<scheduler process is not currently active>
X
X`009.Severity`009error
X`009BADIO`009`009<error in performming mailbox I/O>
X`009NOID`009`009</IDENTIFICATION required with /STRATEGY>
X`009NOBIAS`009`009</BIAS required with /STRATEGY=SMASH or /STRATEGY=NEWIMAGE>
X
X`009.Severity`009fatal
X`009NOTRUNNING`009<process is not currently running>
X`009NOOPTION`009<you must specify an option>
X`009BADAVERAGES`009<six averages must be specified>
X
X`009.Severity   warning
X`009NOQUEUES`009<no more space available to monitor queue, '!AD'>
X`009NOSUCHQ`009`009<unknown queue, !AD, not released>
X`009ACTIVE`009`009<scheduler process is currently running>
X    NOTSTOPPED  <scheduler still appears to be running elsewhere>
X`009.End
$ GoSub Convert_File
$ File_is="SLEEP.MAR"
$ Check_Sum_is=1159660605
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X                $ssdef
X`009`009.psect`009data,rd,wrt,noexe
Xtimebuf:
X`009`009.quad`0090
Xsecond=-10000000
X
X`009`009.psect`009code,exe,rd,nowrt
X`009`009.entry`009sleep,^m<>
X`009`009movl`0094(ap),r0
X`009`009movl`009(r0),r0
X`009`009mull3`009r0,#second,r1
X`009`009movl`009r1,timebuf
X`009`009movl`009#-1,timebuf+4
X`009`009$schdwk_s -
X`009`009`009daytim=timebuf`009
X`009`009blbc`009r0,10$
X;
X`009`009$hiber_s
X`009`009blbs`009r0,20$
X10$:
X`009`009pushl`009r0
X`009`009calls`009#1,g^lib$signal
X20$:
X`009`009ret
X`009`009.end
$ GoSub Convert_File
$ Goto Part4

