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