[comp.os.vms] Nanny Source V1.0 7/14

zar@HAMLET.CALTECH.EDU (Dan Zirin) (06/30/87)

$!------------------------------Cut Here-------------------------
$ chk = "990688998"
$ create nm3.for
$ deck/dollars="ThEgReAtZaR"
c
c       We got all the users, let's do something to them...
c
6       if (first) goto 2
        if (wstotal.gt.maxwstot) maxwstot = wstotal
        crush_p = 0
c
c       If memory is plentiful, turn off suspendok flag
c
        imsk = 'ffffffbf'x.or.functmsk                   !Function 7
        if (imsk.ne.'ffffffff'x.or.wstotal.le.maxphymem.or.maxphymem
     1  .eq.0)              ws_mem_purge = .false.
        if (.not.ws_mem_purge) suspendok = .false.
        do point=1,maxseqnum
         if (pid(point).ne.0.and.system(point).ne.nan$v_unknown) then
c+++++++
c
c       Set the ownership of this process to the master owner process ID
c
           ncputim(point,cpu_average) = ncputim(point,cpu_average) +
     1     sts(point)
13         continue
           if (owner(point).ne.0) then
             i = 1
             do while(pid(i).ne.owner(point).and.i.le.maxseqnum)
              i = i + 1
             end do
             if (i.le.maxseqnum) then
               if (owner(i).ne.0) then
                 owner(point) = owner(i)
                 goto 13
               else
c
c       While we have a pointer to the master PID, make sure the
c       authorized base priorities are the same if this is a sub-
c       process (possible for Nanny to lower prio, user spawns,
c       and subproc authpri is one lower than master (it could
c       propogate, too))
c
                 if (authpri(point).lt.authpri(i).and.owner(point)
     1           .ne.0) authpri(point) = authpri(i)
c
c       If this subprocess has been idle less than master, decrease
c       master's warnings count
c
                 j = lib$extzv(0,16,warn(point))
                 k = lib$extzv(0,16,warn(i))
                 imsk2 = 'ffffefff'x.or.functmsk         !Function 13
                 if (owner(point).ne.0.and.imsk2.eq.'ffffffff'x
     1           .and.j.lt.k) warn(i) = (lib$extzv(0,16,warn(point))
     2           + lib$extzv(16,16,warn(i)) * 2**16)
c
c       If this is a subprocess, and the master isn't a interactive
c       process, the process type should be equiv to the master
c
                 if (owner(point).ne.0.and.system(i).ne.nan$v_inter
     1           .and.system(i).ne.nan$v_inter+nan$_system)
     2           system(point) = system(i)
               end if
             end if
           end if
c+++++++
c
c       If this user has used more than his/her share of cpu, lower
c       priority, else raise.
c
           upri = -1
           if (system(point).lt.nan$v_unknown.and.
     1     authpri(point)-prib(point).le.1) then
             if (system(point).eq.nan$v_batch)   imsk='fffffffe'x.or.
     1       functmsk                                    !Function 1
             if (system(point).eq.nan$v_detach)  imsk='fffffffd'x.or.
     1       functmsk                                    !Function 2
             if (system(point).eq.nan$v_inter)   imsk='fffffffb'x.or.
     1       functmsk                                    !Function 3
             if (system(point).eq.nan$v_network) imsk='fffffff7'x.or.
     1       functmsk                                    !Function 4
             if (owner(point).ne.0)              imsk='ffffffef'x.or.
     1       functmsk                                    !Function 5
             if (imsk.ne.'ffffffff'x) goto 7             !Function disabled
c
c       Preference in raising or lowering priorities
c
             preadd = 0.0
             imsk = 'fffdffff'x.or.functmsk              !Function 18
             if (imsk.eq.'ffffffff'x) then
               acc_p = 1
               do while(account(point)(:len1(account(point))).ne.
     1         prefacc(acc_p)(:len1(prefacc(acc_p))).and.prefadd(acc_p)
     2         .le.100.0)
                acc_p = acc_p + 1
               end do
               if (prefadd(acc_p).le.100.0) preadd = prefadd(acc_p)
             end if
             if (usedpri(authpri(point)).le.0) then
               if (debugging.gt.0) then
                 write(message(1:4),'(i4)') usedpri(authpri(point))
                 write(message(5:6),'(i2)') authpri(point)
                 call output(1,'Number of users @priority '//
     1           message(5:6)//' is '//message(1:4)//'. Reset to 1')
               end if
               usedpri(authpri(point)) = 1
             end if
             upri        = -1
             new_cputim  = 0.0
             do i=1,cpu_average
              new_cputim = new_cputim + float(ncputim(point,i))
             end do
c
c       Total new CPU for averaging cycles / # of averaging cycles /
c       (cycle time * preference)
c
             new_cputim  = new_cputim / float(cpu_average) /
     1       float(waitim)             !(float(waitim)*preadd)
c
c       If (cycle time / # users @ this prio) / cycle time < 90% of above
c       drop priority, else if > 110% of above raise if prio is low.
c
             if ((float(waitim)/float(usedpri(authpri(point))))/
     1       float(waitim).lt.new_cputim*0.9) then
               upri = authpri(point) - 1
             else if ((float(waitim)/float(usedpri(authpri(
     1       point))))/float(waitim).gt.new_cputim*1.1) then
               if (authpri(point).gt.prib(point)) upri =
     1         authpri(point)
             end if
             if (upri.gt.0.and.upri.ne.prib(point)) then
5              continue
               code = sys$setpri(pid(point),,%val(upri),)
               if (code.eq.ss$_normal.or.code.eq.ss$_nonexpr) then
                 if (debugging.ne.0) then
                   write(message,'(a,i1,a,i1,a,i1,f7.3)') username(
     1             point)(:len1(username(point)))//' priority changed'//
     2             ' to ',upri,' from ',prib(point),': usertype = ',
     3             system(point),new_cputim
                   call output(1,message(:len1(message)))
                   if (code.eq.ss$_normal) then
                     if (upri.gt.prib(point)) call sys$brkthru(,%descr(
     1               'Nanny: Your priority has been restored'),%descr(
     2               terminal(point)(:len1(terminal(point)))),%val(
     3               brk$c_device),,,,,%val(5),,)
                     if (upri.lt.prib(point)) call sys$brkthru(,%descr(
     1               'Nanny: Your priority has been lowered'),%descr(
     2               terminal(point)(:len1(terminal(point)))),%val(
     3               brk$c_device),,,,,%val(5),,)
                   end if
                 end if
                 prib(point)    = upri
                 crush_p        = crush_p + 1
                 crush(crush_p) = pid(point)
                 crpri(crush_p) = authpri(point)
               else
                 if (bug(code,'SETPRI').ne.ss$_normal) then
                   write(message,'(a,i1,a,z8)') 'Unable to change '//
     1             username(point)(:len1(username(point)))//' to pri'//
     2             'ority ',upri,' because: ',code
                   call output(1,message(:len1(message)))
                 end if
               end if
             end if
7            continue
c+++++++
c
c       Suspend low priority processes if memory is fully utilized
c
             if (suspendok.and.authpri(point).eq.lowbat.and.
     1       system(point).eq.nan$v_batch) then
               if (debugging.eq.1) then
                 code = ss$_normal
               else
                 code = sys$suspnd(pid(point),)
               end if
               if (bug(code,'SUSPND').eq.ss$_normal) then
                 if (debugging.ne.1) write(message,'(a,i1,a)',err=9)
     1           username(point)(:len1(username(point)))//'''s batch '//
     2           'job was suspended at priority ',authpri(point),
     3           ' (low mem)'
                 call output(1,message(:len1(message)))
                 suspendok          = .false.
                 suspids            = suspids + 1
                 susp_ipid(suspids) = ipid(point)
                 susp_pid(suspids)  = pid(point)
               else
                 call output(1,'Unable to suspend '//username(point)(:
     1           len1(username(point)))//'''s batch job (low mem)')
               end if
9              continue
             end if
           end if
c+++++++
c
c       Check for idle processes
c
           imsk = 'ffffdfff'x.or.functmsk                !Function 14
c
c       If the process is normal interactive, normal subprocess, or
c       (system inetractive and system logoff is on), then...
c
           if (maxidle.ne.0.and.(system(point).eq.nan$v_inter
     1     .or.system(point).eq.nan$v_subproc.or.(system(point)
     2     .eq.nan$v_inter+nan$_system.and.imsk.eq.'ffffffff'x)))
     3     then
c
c       If the process has been idle => maxidle and (a subprocess or
c       a interactive process with a physical terminal) then...
c
             if (lib$extzv(0,16,warn(point)).ge.maxidle.and.((
     1       lench(phy_term(point)).gt.0.and.(system(point).eq.
     2       nan$v_inter.or.system(point).eq.nan$v_inter+
     3       nan$_system)).or.system(point).eq.nan$v_subproc))
     4       then
c
c       If tree logoff is on and this is a subprocess, ignore
c
               imsk2 = 'ffffefff'x.or.functmsk           !Function 13
               if (imsk2.ne.'ffffffff'x.or.(imsk2.eq.'ffffffff'x
     1         .and.system(point).ne.nan$v_subproc)) then
                 if (debugging.ne.1) then
                   code = sys$forcex(pid(point),,%val('2c'x))
                   call bug(code,'FORCEX')
                   code = sys$delprc(pid(point),)
                 else
                   code = ss$_normal
                 end if
                 message = username(point)(:len1(username(point)))//
     1           ' on '//terminal(point)(:len1(terminal(point)))//
     2           ' has been logged off by Nanny'//char(7)
                 if (bug(code,'DELPRC').eq.ss$_normal) then
                   code = ss$_normal
                   if (system(point).ne.nan$v_subproc) code =
     1             sys$brkthru(,%descr(message(:len1(message))),
     2             %descr(terminal(point)(:len1(terminal(point)))),
     3             %val(brk$c_device),,,,,%val(5),,)
                   call bug(code,'BRKTHRU')
                   call output(2,message(:len1(message)-1))
                   pid(point) = 0
                 else
                   if (code.ne.ss$_nonexpr) then
                     call output(1,'Unable to logoff '//username(
     1               point)(:len1(username(point)))//' on '//
     2               terminal(point)(:len1(terminal(point))))
                   else
                     call output(2,message(:len1(message)-1))
                     pid(point) = 0
                   end if
                 end if
               end if
             end if
c
c       If the process has been idle => maxidle/2 and we haven't warned
c       this process already, then...
c
             if (lib$extzv(0,16,warn(point)).ge.maxidle/2.and.
     1       warned(point).lt.1) then
               warned(point) = warned(point) + 1
               code = ss$_normal
               imsk='ffffbfff'x.or.functmsk              !Function 15
               i = (maxidle - lib$extzv(0,16,warn(point))) *
     1         waitim
               if (imsk.eq.'ffffffff'x.and.system(point).ne.
     1         nan$v_subproc) call warnuser(pid(point),
     2         terminal(point),username(point),i)
             end if
c
c       If the process has one cycle left before maxidle = idle time and
c       we haven't warned this process already, then...
c
             if (lib$extzv(0,16,warn(point)).ge.maxidle-2.and.
     1       warned(point).lt.2) then
               warned(point) = warned(point) + 1
               imsk='ffff7fff'x.or.functmsk              !Function 16
               if (imsk.eq.'ffffffff'x) then
                 message       = char(7)//username(point)(:len1(
     1           username(point)))//' on '//terminal(point)(:len1(
     2           terminal(point)))//' has been inactive. Last '//
     3           'warning prior to process deletion'//char(7)//
     4           char(7)
                 code = ss$_normal
                 if (system(point).ne.nan$v_subproc) code =
     1           sys$brkthru(,%descr(message(:len1(message))),
     2           %descr(terminal(point)(:len1(terminal(point)))),
     3           %val(brk$c_device),,,,,%val(5),,)
                 call bug(code,'BRKTHRU')
               end if
             end if
           end if
ThEgReAtZaR
$ checksum nm3.for
$ if chk.nes.checksum$checksum then write sys$output -
  "NM3.FOR didn't pass checksum. File may be corrupted."
$ if chk.nes.checksum$checksum then e             if