zar@JULIET.CALTECH.EDU.UUCP (06/18/87)
$!------------------------------Cut Here-------------------------
$ chk = "1209503388"
$ required = "nm1.for"
$ if "''f$search(required)'".eqs."" then write sys$output -
"File NM1.FOR must exist prior to running this procedure."
$ if "''f$search(required)'".eqs."" then exit %x2c
$ create nm2.for
$ deck/dollars="ThEgReAtZaR"
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
c+++++++
c
c Elapsed time logoff doesn't care what you are doing (CPU and
c I/O activity are ignored).
c
imsk = 'ffffdfff'x .or. functmsk !Function 14
if (maxelapsed.gt.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 Terminate the program execution of a user if maxelapsed time
c has been exceeded (idle logoff will destroy the user later
c we hope). Idle logoff normally gets them before this check
c unless the program being run is something like KERMIT which
c increases I/O and CPU even though the user hasn't touched the
c keyboard.
c
if (lib$extzv(16,16,warn(point)).ge.maxelapsed) then
if (debugging.ne.1) then
code = sys$forcex(pid(point),,%val('2c'x))
else
code = ss$_normal
end if
message = username(point)(:len1(username(point)))//
1 ' on '//terminal(point)(:len1(terminal(point)))//
2 ' has exceeded maximum login time'//char(7)
if (bug(code,'FORCEX').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))
warn(point) = lib$extzv(0,16,warn(point))
else
if (code.ne.ss$_nonexpr) then
call output(1,'Unable to FORCEX '//username(
1 point)(:len1(username(point)))//' on '//
2 terminal(point)(:len1(terminal(point))))
else
call output(2,message(:len1(message)-1))
warn(point) = lib$extzv(0,16,warn(point))
end if
end if
end if
c
c They do get one warning prior to exceeding maxelapsed
c
if (lib$extzv(16,16,warn(point)).ge.maxelapsed-1) then
message = char(7)//username(point)(:len1(
1 username(point)))//' on '//terminal(point)(:len1(
2 terminal(point)))//' has exceeded maximum login '//
3 'time. Image will be terminated regardless of '//
4 'user actions'//char(7)//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
end do
c+++++++
c
c We will reset priorities we lowered in (waitim/10) seconds
c
c second3(1) = waitim * -100000
c code = sys$setimr(,second3,boost,%val(2))
c if (bug(code,'SETIMR').ne.ss$_normal) call output(1,'Unable '//
c 1 'to reset priorities')
c+++++++
c
c Resume low priority batch jobs if memory is not being used
c (first in last out one resumed per cycle)
c
imsk = 'ffffffbf'x.or.functmsk !Function 7
if (imsk.eq.'ffffffff'x.and.wstotal.lt.lowphymem.and.
1 lowphymem.ne.0.and.suspids.gt.0) then
if (resumeok) then
point = susp_ipid(suspids)
if (debugging.eq.1) then
code = ss$_normal
else
code = sys$resume(susp_pid(suspids),)
end if
if (code.eq.ss$_normal.or.code.eq.ss$_nonexpr) then
susp_ipid(suspids) = 0
susp_pid(suspids) = 0
suspids = suspids - 1
call output(1,'Resumed '//username(point)(:len1(username(
1 point)))//' (mem)')
else
call bug(code,'RESUME')
call output(1,'Unable to resume '//username(point)(:len1(
1 username(point)))//' (mem)')
end if
else
resumeok = .true.
end if
else
resumeok = .false.
end if
c-------
c
c Create a new log file for each day.
c
2 first = .false.
call date(cur_date)
if (cur_date(1:2).ne.old_date) then
if (debugging.ne.0) then
write(message,'(a40,i5)',err=8) 'Daily maximum physical '//
1 'memory usage was ',maxwstot
call output(1,message(:len1(message)))
maxwstot = 0
end if
8 call new_log(dumy)
old_date = cur_date(1:2)
cycle_num = 0
c
c Purge working set at midnight if WSPurge is off
c
if (.not.purgews) then
code = sys$purgws(wstore)
call bug(code,'PURGWS')
end if
call dayweek(.false.)
dst_chk = .true.
end if
c
c Change SYS$ANNOUNCE to node name + load average
c
imsk = 'f7ffffff'x .or. functmsk !Function 28
if (imsk.eq.'ffffffff'x) then
c call something !???
end if
c
c Daylight savings check (2:00am)
c
call time(cur_date(1:8))
if (dst_chk.and.cur_date(1:2).eq.'02') then
imsk = 'efffffff'x .or. functmsk !Function 29
if (imsk.eq.'ffffffff'x) call dayweek(.false.)
dst_chk = .false.
end if
c
c Are we debugging the Nanny
c
debugging = 0
imsk = 'bfffffff'x .or. functmsk !Function 31
if (imsk.eq.'ffffffff'x) debugging = 1
imsk = '7fffffff'x .or. functmsk !Function 32
if (imsk.eq.'ffffffff'x) debugging = 2 !debugging + 2
c
c Purge working set and wait for another cycle
c
if (purgews.or.ws_mem_purge) then
code = sys$purgws(wstore)
call bug(code,'PURGWS')
end if
call sys$hiber()
call sys$cantim(%val(1),)
c
c If we were told to DIE, do so
c
if (die.eq.1) then
close(unit=6)
call sys$delmbx(%val(mbxchan))
call exit
end if
c
c Loop again
c
goto 1
c
c Errors
c
3 call output(2,'Forced exit: Parameter file error')
call sys$exit(%val('2c'x))
4 call output(2,'Forced exit: Timer error')
call sys$exit(%val('2c'x))
c
end
ThEgReAtZaR
$ checksum nm2.for
$ if chk.nes.checksum$checksum then write sys$output -
"NM2.FOR didn't pass checksum. File may be corrupted."
$ if chk.nes.checksum$checksum then exit %x2c
$ copy/log nm1.for+nm2.for nmain.for
$ if $status then delete/log nm1.for;,nm2.for;
$ exit