program Nanny c c My Daemon (Nanny) c Use at your own risk! c c Written by Daniel M. Zirin for Zar Limited c (c) Zar Limited 1983,1985,1986,1987,1988 c Zar Limited c P.O.Box 372 c Pasadena, CA 91102 c U.S.A. c Available on DECUS Library as catalog number VAX-66 (sparatic c updates are sent -- last was V1.0 -- next will be V2.4) c Tape processing fees: $22 (you supply a 600' tape or TK50) c $42 (I supply 600' tape) c $102 (I supply TK50) c ZAR @ CITCHEM (bitnet) c ZAR @ XHMEIA.Caltech.Edu ([192.12.19.15] arpa) c XHMEIA::ZAR (area 5 node 920 span/hepnet) c Free network distribution available: c 1) Anonymous FTP from Hamlet.Caltech.Edu, c Iago.Caltech.Edu, Juliet.Caltech.Edu, c Romeo.Caltech.Edu in the directory DIST$:[NANNY]. c Read the file 000READ.ME first. c 2) DECNET copy of VMS Backup save-set containing c DCL archives (same as what is distributed by c e-mail). See the file DIST$:[NANNY]000READ.ME on c node SHAKES (area 5 node 859). c 3) Electronic mail. Send e-mail to one of the above c three addresses. This method uses checksums to c determine if distribution is received without c data loss. Only one attempt will be made. c c Nanny command syntax: c command ret_mail_box own_pid parameters c c Nanny input bit masks: c Debugging 0 - No debugging messages c (Bits 31 & 32 1 - Do not execute vital functions and display c of the Function extra messages c mask) 2 - Execute all functions and display extra c messages c c Function mask Bit Meaning c 1 - Allow batch priority dither c 2 - Allow detach priority dither c 3 - Allow normal user priority dither c 4 - Allow network process priority dither c 5 - Allow subprocess priority dither c 6 - CPU total is accumulated by all dup procs c 7 - Resume processes suspended for low memory c after suspend time exceeds maxsuspend c 8 - Allow batch processes to be suspended c + 9 - Allow detach processes to be suspended c +10 - Allow normal processes to be suspended c +11 - Allow network processes to be suspended c +12 - Allow subprocesses to be suspended c 13 - If set, logoff entire process tree when c idle. If clear, logoff process with no c subprocesses first c 14 - If set, system users are subject to idle- c time logout (interactive only) c 15 - Give idle time warning @1/2 maxidle c 16 - Give idle time warning @<60 seconds left c 17 - If set, prefix the last warning message c for idle logoff with 3 form-feeds c 18 - Give CPU warning @time-cycle c 19 - Allow preference dither c 20 - Do not allow mulpile outstanding wake-up c calls for a single destination. c 21 - If set, the minimum I/O .AND. the minimum c CPU must be utilized to be non-idle. If c clear, the minimum I/O .OR. the minimum c CPU must be used to be non-idle. c +22 - Not used c +27 - Not used c 28 - Assign/system node name and load average c to sys$announce c 29 - Assign/system the day of week and allow c time reset for DST c +30 - Reserved c 31 - Debugging bit 1 c 32 - Debugging bit 2 c + = Not implemented yet c c Command msk Bit Meaning c 1 - Disable ADDACC command c 2 - Disable DIE command c 3 - Disable ENTER command c 4 - Disable FORGET command c 5 - Disable FREE command c 6 - Disable GRAB command c 7 - Disable IDLESET command c 8 - Disable IGNORE command c 9 - Disable ISHOW command c 10 - Disable KILL command c 11 - Disable LISTEN command c 12 - Disable NEW command c 13 - Disable ODIS command c 14 - Disable OEN command c 15 - Disable PAUSE command c 16 - Disable QSTART command c 17 - Disable QSTOP command c 18 - Disable READ command c 19 - Disable REQUEUE command c 20 - Disable RESUME command c 21 - Disable STOP command c 22 - Disable SUSPEND command c 23 - Disable VERSION command * c 24 - Disable WAKE command * c 25 - Disable WCLR command * c 26 - Disable WDUMP command c 27 - Disable WSHOW command * c 28 - Not used c 32 - Not used c c * = Returns special values/output in return mailbox. See help file. c c OUTPUT routine 0 - Output to OPA0: only c 1 - Output to logfile only c 2 - Output to OPA0: and logfile c c Created Zar ltd. 20-May-83 c Revised Zar ltd. 30-Jun-83 c Revised Zar ltd. 2-Aug-83 c Revised Zar ltd. 30-Oct-83 c Revised Zar ltd. 5-Oct-85 for VMS V4 c Revised Zar ltd. 9-Jun-87 V1.0 c Revised Zar ltd. 9-Jul-87 V1.1 c Revised Zar ltd. 17-Jul-87 V1.2 c Revised Zar ltd. 3-Aug-87 V2.0 c Revised Zar ltd. 22-Aug-87 V2.1 c Revised Zar ltd. 9-Sep-87 V2.2 c Revised Zar ltd. 23-Sep-87 V2.3 c Revised Zar ltd. 1-Jan-88 V2.4 c parameter pcb$v_batch = '00e'x parameter pcb$v_netwrk = '015'x parameter sch$c_cef = 3 parameter sch$c_colpg = 1 parameter sch$c_com = 12 parameter sch$c_como = 13 parameter sch$c_cur = 14 parameter sch$c_fpg = 11 parameter sch$c_hib = 7 parameter sch$c_hibo = 8 parameter sch$c_lef = 5 parameter sch$c_lefo = 6 parameter sch$c_mwait = 2 parameter sch$c_pfw = 4 parameter sch$c_susp = 9 parameter sch$c_suspo = 10 implicit integer*4 (a-z) include 'nanny.inc' include '($brkdef)' include '($dvidef)' include '($jpidef)' include '($lnmdef)' include '($ssdef)' c include '($statedef)' !Not in FORTRAN lib defs include '($syidef)' character*255 sys_announce character*100 message character*23 cur_datim character*12 username(maxuser) character*10 terminal(maxuser) character*8 cur_time character*8 account(maxuser) character*2 old_date integer*4 sys_intl integer*4 dvi_lis(4) integer*4 lnm_lis(4) integer*4 boottime(2) integer*4 uptime(2) integer*4 cur_dayear integer*4 authpriv(maxuser,2) integer*4 bufio(maxuser) integer*4 cputim(maxuser) integer*4 dirio(maxuser) integer*4 ncputim(maxuser,max_average) integer*4 owner(maxuser) integer*4 pageflts(maxuser) integer*4 second3(2) integer*4 seedpid integer*4 sts(maxuser) integer*4 warn(maxuser) integer*4 wssize(maxuser) integer*4 wstore(2) integer*2 susptim(maxuser) integer*2 o_seqnum integer*2 uic(maxuser,2) integer*2 usedpri(0:31) real*4 new_cputim real*4 preadd logical*1 dst_chk logical*1 dumy logical*1 first logical*1 limwarn(maxuser) logical*1 mod_sysann logical*1 resumeok logical*1 suspendok logical*1 susp_flg(maxuser) logical*1 warned(maxuser) logical*1 ws_mem_purge external nanjpi,nanjpi_ini,gotmess,wait_rel,boost c c First check to see if we should even bother starting by c comparing SYSGEN parameter MAXPROCESSCNT with MAXUSER c dvi_lis(1) = syi$_maxprocesscnt * 2**16 + 4 dvi_lis(2) = %loc(i) dvi_lis(3) = 0 dvi_lis(4) = 0 code = sys$getsyiw(,,,dvi_lis,,,) if (.not.code.or.i.gt.maxuser) then call output(2,'Maxuser exceeded! Nanny must be '// 1 'recompiled with a larger maxuser!') call sys$exit(%val('45'x)) stop end if c c Now check to see that some fool hasn't started interactivly c running this program thinking its NANNYACP c dvi_lis(1) = jpi$_mode * 2**16 + 4 dvi_lis(2) = %loc(i) dvi_lis(3) = 0 dvi_lis(4) = 0 code = sys$getjpiw(,,,dvi_lis,,,) if (.not.code.or.i.ne.jpi$k_other) then call output(2,'This is not an interactive program!') call sys$exit(%val('56'x)) stop end if code = sys$setrwm(%val(1)) !Don't go into MWAIT code = sys$setswm(%val(1)) !Don't ever get swapped out c c Lock most of our common variables into the working set so c it doesn't get trimmed by purging working set c wstore(1) = %loc(crush(maxuser)) wstore(2) = %loc(crush(1)) call sys$lkwset(wstore,,) wstore(1) = %loc(lasterr(maxdisks)) wstore(2) = %loc(lasterr(1)) call sys$lkwset(wstore,,) wstore(1) = %loc(loadave(4)) wstore(2) = %loc(loadave(1)) call sys$lkwset(wstore,,) wstore(1) = %loc(susp_ipid(maxuser)) wstore(2) = %loc(susp_ipid(1)) call sys$lkwset(wstore,,) wstore(1) = %loc(idle_val(maxuser)) wstore(2) = %loc(idle_val(1)) call sys$lkwset(wstore,,) wstore(1) = %loc(susptim(maxuser)) wstore(2) = %loc(susptim(1)) call sys$lkwset(wstore,,) wstore(1) = %loc(truewait(2)) wstore(2) = %loc(truewait(1)) call sys$lkwset(wstore,,) wstore(1) = %loc(waitim) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(authpri(maxuser)) wstore(2) = %loc(authpri(1)) call sys$lkwset(wstore,,) wstore(1) = %loc(crpri(maxuser)) wstore(2) = %loc(crpri(1)) call sys$lkwset(wstore,,) wstore(1) = %loc(mbx2) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(mbx3) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(mbxchan) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(prib(maxuser)) wstore(2) = %loc(prib(1)) call sys$lkwset(wstore,,) wstore(1) = %loc(debugging) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(disable) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(functmsk) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(c_authpriv(2)) wstore(2) = %loc(c_authpriv(1)) call sys$lkwset(wstore,,) wstore(1) = %loc(c_bufio) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(c_cpulim) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(c_cputim) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(c_dirio) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(c_owner) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(c_pageflts) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(c_ipid) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(c_pid) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(c_prccnt) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(c_prib) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(c_state) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(c_sts) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(c_uic(2)) wstore(2) = %loc(c_uic(1)) call sys$lkwset(wstore,,) wstore(1) = %loc(c_wssize) wstore(2) = wstore(1) call sys$lkwset(wstore,,) wstore(1) = %loc(c_account(8:8)) wstore(2) = %loc(c_account) call sys$lkwset(wstore,,) wstore(1) = %loc(c_phy_term(10:10)) wstore(2) = %loc(c_phy_term) call sys$lkwset(wstore,,) wstore(1) = %loc(c_terminal(10:10)) wstore(2) = %loc(c_terminal) call sys$lkwset(wstore,,) wstore(1) = %loc(c_username(12:12)) wstore(2) = %loc(c_username) call sys$lkwset(wstore,,) wstore(1) = %loc(system(maxuser)) wstore(2) = %loc(system(1)) call sys$lkwset(wstore,,) wstore(1) = %loc(pid(maxuser)) wstore(2) = %loc(pid(1)) call sys$lkwset(wstore,,) wstore(1) = %loc(inbuff(128)) wstore(2) = %loc(inbuff(1)) call sys$lkwset(wstore,,) wstore(1) = %loc(announce(80:80)) wstore(2) = %loc(announce) call sys$lkwset(wstore,,) wstore(1) = %loc(sys_announce(255:255)) wstore(2) = %loc(sys_announce) call sys$lkwset(wstore,,) wstore(1) = %loc(ig_user(maxig_user)) wstore(2) = %loc(ig_user(1)) call sys$lkwset(wstore,,) wstore(1) = %loc(ig_term(maxig_term)) wstore(2) = %loc(ig_term(1)) call sys$lkwset(wstore,,) wstore(1) = %loc(disks(maxdisks)) wstore(2) = %loc(disks(1)) call sys$lkwset(wstore,,) c c Initialize some variables c all_commands(nan$c_addacc) = 'ADDACC' all_commands(nan$c_die) = 'DIE' all_commands(nan$c_enter) = 'ENTER' all_commands(nan$c_forget) = 'FORGET' all_commands(nan$c_free) = 'FREE' all_commands(nan$c_grab) = 'GRAB' all_commands(nan$c_idleset) = 'IDLESET' all_commands(nan$c_ignore) = 'IGNORE' all_commands(nan$c_ishow) = 'ISHOW' all_commands(nan$c_kill) = 'KILL' all_commands(nan$c_listen) = 'LISTEN' all_commands(nan$c_new) = 'NEW' all_commands(nan$c_odis) = 'ODIS' all_commands(nan$c_oen) = 'OEN' all_commands(nan$c_pause) = 'PAUSE' all_commands(nan$c_qstart) = 'QSTART' all_commands(nan$c_qstop) = 'QSTOP' all_commands(nan$c_read) = 'READ' all_commands(nan$c_requeue) = 'REQUEUE' all_commands(nan$c_resume) = 'RESUME' all_commands(nan$c_stop) = 'STOP' all_commands(nan$c_suspend) = 'SUSPEND' all_commands(nan$c_version) = 'VERSION' all_commands(nan$c_wake) = 'WAKE' all_commands(nan$c_wclr) = 'WCLR' all_commands(nan$c_wdump) = 'WDUMP' all_commands(nan$c_wshow) = 'WSHOW' all_functs(nan$f_bdithr) = 'BDITHR' all_functs(nan$f_ddithr) = 'DDITHR' all_functs(nan$f_idithr) = 'IDITHR' all_functs(nan$f_ndithr) = 'NDITHR' all_functs(nan$f_sdithr) = 'SDITHR' all_functs(nan$f_dupcpu) = 'DUPCPU' all_functs(nan$f_ressusp) = 'RESSUSP' all_functs(nan$f_bsusp) = 'BSUSP' all_functs(nan$f_dsusp) = 'DSUSP' all_functs(nan$f_isusp) = 'ISUSP' all_functs(nan$f_nsusp) = 'NSUSP' all_functs(nan$f_ssusp) = 'SSUSP' all_functs(nan$f_treelo) = 'TREELO' all_functs(nan$f_syslo) = 'SYSLO' all_functs(nan$f_halfidl) = 'HALFIDL' all_functs(nan$f_lastidl) = 'LASTIDL' all_functs(nan$f_clridl) = 'CLRIDL' all_functs(nan$f_cpuwarn) = 'CPUWARN' all_functs(nan$f_pfdithr) = 'PFDITHR' all_functs(nan$f_onewake) = 'ONEWAKE' all_functs(nan$f_iocpu) = 'IO&CPU' all_functs(nan$f_sysann) = 'SYSANN' all_functs(nan$f_upddst) = 'UPDDST' all_functs(nan$f_nofunc) = 'NOFUNC' all_functs(nan$f_debug) = 'DEBUG' die = 0 mod_sysann = .false. cycle_num = 0 suspids = 0 maxwstot = 0 c_uic(2) = 1 !Fake current UIC is the SYSMGR's c_uic(1) = 4 wstore(1) = '7fffffff'x wstore(2) = 0 startup_flg = .false. listen = .false. first = .true. debugging = 0 resumeok = .false. dvi_lis(1) = dvi$_tt_phydevnam * 2**16 + 10 dvi_lis(2) = %loc(c_phy_term) dvi_lis(3) = 0 dvi_lis(4) = 0 do i=1,maxuser pid(i) = 0 wssize(i) = 0 susp_flg(i) = 0 susp_ipid(i) = 0 susptim(i) = 0 limwarn(i) = 0 do j=1,max_average ncputim(i,j) = 0 end do end do call sys$bintim('0 0:0:3.0',second3) call lib$date_time(cur_datim) old_date = cur_datim(1:2) call waker('1',0,c_uic,old_date(1:1)) !Init the wake-up calls call wrdmp !Restore outstanding wake-ups c c Find out what day of the year today is c call sys$bintim(cur_datim(:11)//' 0:0:0.0',boottime) call sys$bintim('1-JAN-'//cur_datim(8:11)//' 0:0:0.0',uptime) call lib$subx(uptime,boottime,uptime) call sys$asctim(,cur_datim(:16),uptime,) read(cur_datim(:4),'(i4)') cur_dayear cur_dayear = cur_dayear + 1 imsk = 'f7ffffff'x .or. functmsk !Function 28 if (imsk.eq.'ffffffff'x) call mod_ann(sys_announce, 1 sys_intl,announce,loadave,wstotal,maxwstot) c c Declerations done, lets annoy some users c code = sys$setprn('Nanny') c c Get parameters from input file. c call new_log(dumy) if (dumy.ne.ss$_normal) goto 3 call output(1,'Nanny '//version) c c Day of week setup c call dayweek(.true.,cur_dayear) dst_chk = .true. c c Create a mailbox for communication to the outside world and c to read termination messages when sending messages to the c system managers. c (needs PRMMBX priv) c code = sys$crembx(%val(1),mbxchan,,,,,'NANNYS$BOX') if (bug(code,'CREMBX').ne.ss$_normal) call sys$exit(%val(code)) code = sys$crembx(%val(0),mbx2,,,,,) if (bug(code,'CREMBX').ne.ss$_normal) call sys$exit(%val(code)) code = sys$crembx(%val(1),mbx3,,,,,'NANNY$PEEK') if (bug(code,'CREMBX').ne.ss$_normal) call sys$exit(%val(code)) call loop c c (start of infinite loop) c c Set a timer to wake-up after hibernating c call output(0,'Logfile initialized') vaxstep = -1 1 continue suspendok = .false. ws_mem_purge= .true. seedpid = -1 jpicode = 0 wstotal = 0 dis_ttys = 0 highbat = -1 lowbat = 32 cycle_num = cycle_num + 1 do i = 0, 31 usedpri(i) = 0 end do if (vaxstep.eq.1) o_seqnum = 0 if (vaxstep.eq.-1) o_seqnum = maxuser + 1 code = sys$setimr(,truewait,wait_rel,%val(1)) if (bug(code,'SETIMR').ne.ss$_normal) goto 4 c c As long as there are users c do while(jpicode.ne.ss$_nomoreproc) c c Do the $GETJPI service in EXECutive mode c (needs CMEXEC & WORLD privs) c If the $GETJPI is done in EXEC, it won't be interrupted by c a user mode AST delivery c ranjpipid = seedpid jpicode = sys$cmexec(nanjpi_ini,) seedpid = ranjpipid if (jpicode.ne.ss$_nopriv.and.jpicode.ne.ss$_nomoreproc.and. 1 jpicode.ne.ss$_suspended) jpicode = bug(jpicode,'GETJPI1') c c Logoff processes with usernames = '', a virtual terminal, c and no physical terminal (happens when virtual terminals are set c secure and a user hits twice while logging in). c if (jpicode.eq.ss$_normal.and.c_pid.ne.0) then if (c_username(:len1(c_username)).eq.''.and.lench( 1 c_terminal).gt.0.and.lench(c_phy_term).eq.0) then code = sys$delprc(c_pid,) if (code) then message = 'Zombie login process using '//c_terminal(: 1 len1(c_terminal))//' was logged off' call output(1,message(:len1(message))) c_pid = 0 end if end if end if c c Get the current user's sequence number (PROC_INDEX) c point = c_ipid if (point.gt.maxuser) then call output(2,'Maxuser exceeded! Nanny must be '// 1 'recompiled with a larger maxuser!') goto 10 end if if (maxseqnum.lt.point) maxseqnum = point c c If the process is not swapped out and is a process we are c interested in, do a complete $GETJPI (default mode does c issue a full $GETJPI) c full_jpi = 1 c c If both idle logoff and priority dither are disabled/off c don't issue a full $GETJPI c if (lib$extzv(0,5,functmsk).eq.0) then !Functions 1-5 if (maxidle.eq.0.or.idle_val(point).eq.0) full_jpi = 0 if (minio.eq.0.and.mintim.eq.0) full_jpi = 0 end if c c If the process is swapped out and (idle logoff is off c or this cycle is less than the maxidle/2 cycle), don't c issue a full $GETJPI c if (c_state.eq.sch$c_como.or.c_state.eq.sch$c_cur.or. 1 c_state.eq.sch$c_hibo.or.c_state.eq.sch$c_lefo.or. 2 c_state.eq.sch$c_mwait.or.c_state.eq.sch$c_susp.or. 3 c_state.eq.sch$c_suspo) then if (maxidle.eq.0.or.idle_val(point).eq.0) then full_jpi = 0 else if (minio.eq.0.and.mintim.eq.0) then full_jpi = 0 else if (lib$extzv(0,16,warn(point)).lt.idle_val( 1 point)/2) full_jpi = 0 end if end if end if if (point.ne.0.and.pid(point).eq.0) full_jpi = 1 if (c_pid.eq.0.or.jpicode.ne.ss$_normal) full_jpi = 0 c c Do the full $GETJPI now c if (full_jpi.eq.1) then jpicode = sys$cmexec(nanjpi,) if (jpicode.ne.ss$_nopriv.and.jpicode.ne.ss$_nomoreproc 1 .and.jpicode.ne.ss$_suspended) jpicode = bug(jpicode, 2 'GETJPI2') end if c c Delete user's that have logged off c if (jpicode.eq.ss$_nomoreproc) then imsk = 'ffffff7f'x.or.functmsk !Function 8 vaxend = 1 if (vaxstep.eq.1) vaxend = maxuser do i=o_seqnum+vaxstep,vaxend,vaxstep if (imsk.eq.'ffffffff'x) then do j=1,suspids if (i.eq.susp_ipid(j)) then do k=j,suspids-1 susp_ipid(k) = susp_ipid(k+1) susptim(k) = susptim(k+1) end do suspids = suspids - 1 end if end do susp_flg(i) = 0 pid(i) = 0 end if end do end if if ((jpicode.eq.ss$_normal.or.jpicode.eq.ss$_suspended).and. 1 c_pid.ne.0) then c c Get rid of any user's we had that were skipped over. $GETJPI c grabs processes from n to 1 in decreasing order on most systems, c so we look for the vacancy between the last and current process c index. If this is a strange processor that returns processes c from 1 to n in increasing order, the first time through this c loop will not work right but will reset counters for proper c execution for all future loops while Nanny stays up and running. c imsk = 'ffffff7f'x.or.functmsk !Function 8 if (o_seqnum.lt.point.and.vaxstep.eq.-1) vaxstep = 1 do i=o_seqnum+vaxstep,point,vaxstep if (i.ne.point.or.(i.eq.point.and.pid(point).ne.c_pid)) 1 then if (imsk.eq.'ffffffff'x) then do j=1,suspids if (i.eq.susp_ipid(j)) then do k=j,suspids-1 susp_ipid(k) = susp_ipid(k+1) susptim(k) = susptim(k+1) end do suspids = suspids - 1 end if end do end if if (i.ne.point) then susp_flg(i) = 0 pid(i) = 0 end if end if end do o_seqnum = point c c Flag the process if it is suspended c if (jpicode.eq.ss$_suspended.and.susp_flg(point).ne.2) 1 susp_flg(point) = 1 c c If the current PID isn't the same as the one we have for this c sequence number, its a new user. Initialize the counters. c (or if a system user has changed into something else) c if ((pid(point).ne.c_pid).or.(system(point).ge.nan$_system 1 .and.(lench(c_account).gt.0.and.c_uic(2).gt.sysgrp.and. 2 c_account(:len1(c_account)).ne.sysaccnam(:len1(sysaccnam))))) 3 then username(point) = c_username account(point) = c_account terminal(point) = c_terminal idle_val(point) = defidle authpriv(point,1) = c_authpriv(1) authpriv(point,2) = c_authpriv(2) bufio(point) = 0 cputim(point) = 0 dirio(point) = 0 owner(point) = c_owner pageflts(point) = 0 pid(point) = c_pid authpri(point) = c_prib warn(point) = 0 warned(point) = 0 limwarn(point) = 0 c c Determine the type of process we have c typ = nan$v_inter !Default is interactive process if (lib$extzv(pcb$v_batch,1,c_sts).eq.1) typ = nan$v_batch if (lib$extzv(pcb$v_netwrk,1,c_sts).eq.1) 1 typ = nan$v_network if (typ.ne.nan$v_network.and.typ.ne.nan$v_batch.and. 1 lench(c_terminal).eq.0) typ = nan$v_detach if (owner(point).ne.0) typ = nan$v_subproc if (c_uic(2).le.sysgrp.or.c_account(:len1(c_account)).eq. 1 sysaccnam(:len1(sysaccnam)).or.lench(c_account).eq.0.or. 2 c_prib.gt.maxpri) typ = typ + nan$_system system(point) = typ c c If we should ignore this user or terminal set typ to nan$v_unknown c do cnt=1,maxig_user if (lench(ig_user(cnt)).le.0) goto 11 if (ig_user(cnt)(:len1(ig_user(cnt))).eq. 1 c_username(:len1(c_username))) system(point) = 2 nan$v_unknown end do 11 continue if (system(point).ne.nan$v_unknown) then do cnt=1,maxig_term if (lench(ig_term(cnt)).le.0) goto 12 if (ig_term(cnt)(:len1(ig_term(cnt))).eq. 1 c_terminal(:len1(c_terminal))) system(point) = 2 nan$v_unknown end do end if 12 continue end if sts(point) = 0 !Used for new cpu use stats later c c Ignore him if SUSPended c if (susp_flg(point).gt.0.and.system(point).lt.nan$_system) 1 system(point) = system(point) + nan$_system if (c_prib.gt.authpri(point)) authpri(point) = c_prib if (system(point).eq.nan$v_inter.and.lench(c_terminal) 1 .gt.0.and.lench(c_phy_term).eq.0) dis_ttys = dis_ttys + 1 c c Increment elapsed time logoff if the function is on c if (maxelapsed.gt.0.and.lib$extzv(16,16,warn(point)) 1 .lt.maxelapsed) warn(point) = warn(point) + 1 * 2**16 c c Check Normal users for being idle c if (maxidle.gt.0.and.idle_val(point).gt.0.and.(minio 1 .gt.0.or.mintim.gt.0).and.lib$extzv(0,16,warn(point)) 2 .lt.idle_val(point)) then warn(point) = warn(point) + 1 do i=1,cpu_average-1 ncputim(point,i) = ncputim(point,i+1) end do ncputim(point,cpu_average) = 0 c c If this is a subprocess or (this process has a physical c terminal and is an interactive process) then... c if (system(point).eq.nan$v_subproc.or.(lench( 1 c_phy_term).gt.0.and.(system(point).eq.nan$v_inter 2 .or.system(point).eq.nan$v_inter+nan$_system))) then i = 0 c c If the old I/O count + the minimum I/O <= new I/O count... c if (bufio(point)+dirio(point)+minio.le.c_bufio+ 1 c_dirio.and.minio.ne.0) i = i + 1 c c If the old CPU + the minimum CPU <= new CPU... c if (cputim(point)+mintim.le.c_cputim.and.mintim 1 .ne.0) i = i + 1 imsk = 'ffefffff'x.or.functmsk !Function 21 if (imsk.eq.'ffffffff'x.and.i.eq.2) 1 warn(point) = lib$extzv(16,16,warn(point)) * 2**16 if (imsk.ne.'ffffffff'x.and.i.gt.0) 1 warn(point) = lib$extzv(16,16,warn(point)) * 2**16 c c If this process has subprocesses and tree logoff is on... c imsk = 'ffffefff'x.or.functmsk !Function 13 if (imsk.ne.'ffffffff'x.and.c_prccnt.gt.0) 1 warn(point) = lib$extzv(16,16,warn(point)) * 2**16 else warn(point) = lib$extzv(16,16,warn(point)) * 2**16 end if else warn(point) = lib$extzv(16,16,warn(point)) * 2**16 end if if (lib$extzv(0,16,warn(point)).eq.0) warned(point) = 0 c c Figure out total new CPU use for this user in this CPU group c if (system(point).lt.nan$v_unknown) then imsk='ffffffdf'x.or.functmsk !Function 6 if (imsk.eq.'ffffffff'x) then ii = 1 if (vaxstep.eq.-1) ii = maxuser jj = point + 1 if (ii.eq.1) jj = point - 1 do i=ii,jj,vaxstep c c If this is a valid process, our PIDs are different, our c authorized priorities are the same, and our usernames are c the same, then... c if (pid(i).ne.0.and.pid(i).ne.pid(point).and. 1 authpri(i).eq.authpri(point).and.username(i).eq. 2 username(point)) then j = point !J = (>ncpu user) k = i !K = (<=ncpu user) if (ncputim(i,cpu_average).gt.ncputim(point, 1 cpu_average)) j = i if (j.eq.i) k = point c c After getting all processes in this phase of Nanny, 'sts' c will contain extra cpu to add to 'ncputim' for hogs check c sts(j) = sts(k) + ncputim(k,cpu_average) sts(k) = 0 ncputim(k,cpu_average) = 0 usedpri(authpri(point)) = usedpri(authpri( 1 point)) - 1 end if end do end if end if c c Check off potential batch priorities not to suspend c imsk = 'ffffff7f'x.or.functmsk !Function 8 if (imsk.eq.'ffffffff'x) then if (system(point).eq.nan$v_batch) then if (highbat.ne.-1.and.authpri(point).lt.highbat) 1 suspendok = .true. if (authpri(point).gt.highbat) highbat = authpri(point) if (authpri(point).lt.lowbat) lowbat = authpri(point) end if end if c c Total things c if (full_jpi.eq.1) then ncputim(point,cpu_average) = c_cputim - cputim(point) bufio(point) = c_bufio cputim(point) = c_cputim dirio(point) = c_dirio pageflts(point) = c_pageflts wssize(point) = c_wssize else ncputim(point,cpu_average) = 0 end if prib(point) = c_prib if (susp_flg(point).eq.0) wstotal = wstotal + wssize(point) if (lench(c_phy_term).gt.0.and.system(point).lt. 1 nan$v_unknown) usedpri(authpri(point)) = usedpri( 2 authpri(point)) + 1 c c Warn the user if close to his CPU limit c imsk = 'fffdffff'x.or.functmsk !Function 18 if (imsk.eq.'ffffffff'x.and.(system(point).eq.nan$v_inter.or. 1 system(point).eq.nan$v_inter+nan$_system).and.c_cpulim.ne.0) 2 then if (cputim(point).ge.c_cpulim-waitim*2.and.limwarn(point) 1 .lt.2) then if (limwarn(point).eq.0.or.(cputim(point).ge. 1 c_cpulim-waitim)) then call time(cur_time) message = cur_time//' Nanny: You are about to '// 1 'exceed your CPU limit.'//char(7) code = sys$brkthru(,%descr(message(:len1(message))), 1 %descr(terminal(point)(:len1(terminal(point)))), 2 %val(brk$c_device),,,,,%val(5),,) call bug(code,'BRKTHRU') limwarn(point) = limwarn(point) + 1 call output(1,'Warned '//username(point)(:len1( 1 username(point)))//' about CPU time limit') end if end if end if end if end do 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 loadave(1) = 0 loadave(2) = 0 loadave(3) = 0 loadave(4) = 0 c c If memory is plentiful, turn off suspendok flag c imsk = 'ffffff7f'x.or.functmsk !Function 8 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. c+++++++ c c Resume batch jobs if they have exceeded the allowed suspension c time limit c imsk = 'ffffffbf'x.or.functmsk !Function 7 if (imsk.eq.'ffffffff'x.and.maxsuspend.gt.0) then respids = suspids do i=1,suspids if (susp_ipid(i).ne.0) then if (susptim(i).lt.maxsuspend) then susptim(i) = susptim(i) + 1 else point = susp_ipid(i) if (debugging.eq.1) then code = ss$_normal else code = sys$resume(pid(point),) end if if (code.eq.ss$_normal.or.code.eq.ss$_nonexpr) then susp_ipid(i) = 0 susp_flg(point) = 0 respids = respids - 1 call output(1,'Resumed '//username(point)(:len1( 1 username(point)))//' (exceeded maxsuspend)') else call bug(code,'RESUME') call output(1,'Unable to resume '//username(point)(: 1 len1(username(point)))//' (exceeded maxsuspend)') end if end if end if end do c c If we resumed any suspended processes, reorganize the c suspended process list c if (respids.ne.suspids) then suspendok = .false. do i=1,suspids if (susp_ipid(i).eq.0) then do j=i,suspids-1 susp_ipid(j) = susp_ipid(j+1) susptim(j) = susptim(j+1) end do suspids = suspids - 1 end if end do end if end if 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 = 'fffbffff'x.or.functmsk !Function 19 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.eq.1) 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.and.debugging.eq.1) 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) = point susptim(suspids) = 0 susp_flg(point) = 2 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) and the process c has been idle => maxidle, then... c if (maxidle.gt.0.and.idle_val(point).gt.0.and.(system( 1 point).eq.nan$v_inter.or.system(point).eq.nan$v_subproc 2 .or.(system(point).eq.nan$v_inter+nan$_system.and.imsk 3 .eq.'ffffffff'x))) then if (lib$extzv(0,16,warn(point)).ge.idle_val(point)) then c c If the process is a subprocess or an interactive process with c a physical terminal then... c if (system(point).ne.nan$v_subproc) then icode = sys$getdviw(,,%descr(terminal(point)), 1 dvi_lis,,,,) if (.not.icode) c_phy_term = ' ' end if if (system(point).eq.nan$v_subproc.or.(lench( 1 c_phy_term).gt.0.and.(system(point).eq.nan$v_inter 2 .or.system(point).eq.nan$v_inter+nan$_system))) 3 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 c c Try to disconnect process first. If we fail, delete the process. c TTY_DISC is supplied as a dumy routine. To add your own disconnect c code, see the file NDISC.FOR. c code = tty_disc(pid(point),c_phy_term, 1 terminal(point)) if (.not.code) then code = sys$forcex(pid(point),,%val('2c'x)) call bug(code,'FORCEX') code = sys$delprc(pid(point),) end if else code = ss$_normal end if c c Construct a message to tell future users of this terminal c that its now available. c 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(c_phy_term(:len1(c_phy_term))),%val( 3 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 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.idle_val(point)/2 1 .and.warned(point).lt.1) then warned(point) = warned(point) + 1 code = ss$_normal imsk='ffffbfff'x.or.functmsk !Function 15 i = (idle_val(point) - 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.idle_val(point)-2 1 .and.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(username( 1 point)))//' on '//terminal(point)(:len1(terminal( 2 point)))//' has been idle. Last warning prior '// 3 'to process deletion'//char(7)//char(7) imsk2='fffeffff'x.or.functmsk !Function 17 if (imsk2.eq.'ffffffff'x) message = char(12)// 1 char(12)//char(12)//message 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.and. 1 pid(point).ne.0) 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 c+++++++ c c Increment loadave elements according to this process type c if (pid(point).ne.0) then if (system(point).eq.nan$v_inter.or.system(point) 1 .eq.nan$v_inter+nan$_system) then loadave(1) = loadave(1) + 1 else if (system(point).eq.nan$v_subproc) then loadave(2) = loadave(2) + 1 else if (system(point).eq.nan$v_batch) then loadave(3) = loadave(3) + 1 else loadave(4) = loadave(4) + 1 end if end if end if end if end do loadave(4) = loadave(4) + dis_ttys loadave(1) = loadave(1) - dis_ttys 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 = 'ffffff7f'x.or.functmsk !Function 8 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(pid(point),) end if if (code.eq.ss$_normal.or.code.eq.ss$_nonexpr) then susp_ipid(suspids) = 0 susptim(suspids) = 0 susp_flg(point) = 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 lib$date_time(cur_datim) if (cur_datim(1:2).ne.old_date) then if (debugging.ne.0) then write(message,'(a,i5)',err=8) 'Maximum physical '// 1 'memory usage was ',maxwstot call output(1,message(:len1(message))) end if 8 call new_log(dumy) cur_dayear = cur_dayear + 1 if (cur_datim(1:6).eq.' 1-JAN') cur_dayear = 1 old_date = cur_datim(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.,cur_dayear) 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 call mod_ann(sys_announce,sys_intl,announce,loadave, 1 wstotal,maxwstot) mod_sysann = .true. end if c c If function 28 was on but was turned off, we better restore c the old system announce (can't yet so we just make it one c line c if (imsk.ne.'ffffffff'x.and.mod_sysann) then i = index(sys_announce,char(13)) - 1 if (i.lt.0) i = 0 imode = 1 !Indicates EXEC mode lnm_lis(1) = lnm$_string * 2**16 + i lnm_lis(2) = %loc(sys_announce) lnm_lis(3) = 0 lnm_lis(4) = 0 code = sys$crelnm(,%descr('LNM$SYSTEM_TABLE'), 1 %descr('SYS$ANNOUNCE'),imode,lnm_lis) if (bug(code,'CRELNM').eq.ss$_normal) mod_sysann = .false. end if c c Daylight savings check (2:00am). The flag DST_CHK keeps c from resetting the clock back an hour in an infinite loop. c call time(cur_time) if (dst_chk.and.cur_time(1:2).eq.'02') then imsk = 'efffffff'x .or. functmsk !Function 29 if (imsk.eq.'ffffffff'x) call dayweek(.false.,cur_dayear) 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 10 call sys$delmbx(%val(mbxchan)) call sys$delmbx(%val(mbx2)) call sys$delmbx(%val(mbx3)) c c Clean up the SYS$ANNOUNCE flag if its been changed c imsk = 'f7ffffff'x .or. functmsk !Function 28 i = index(sys_announce,char(13)) - 1 if (imsk.eq.'ffffffff'x.and.i.gt.0) then imode = 1 !Indicates EXEC mode lnm_lis(1) = lnm$_string * 2**16 + i lnm_lis(2) = %loc(sys_announce(:i)) lnm_lis(3) = 0 lnm_lis(4) = 0 code = sys$crelnm(,%descr('LNM$SYSTEM_TABLE'), 1 %descr('SYS$ANNOUNCE'),imode,lnm_lis) call bug(code,'CRELNM') end if c c Save wake-up calls for the future c call wdump(' ',1,dumy) call sys$exit(%val(3)) 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