zar@JULIET.CALTECH.EDU (Dan Zirin) (06/18/87)
$!------------------------------Cut Here-------------------------
$ chk = "1063780678"
$ create nf2.for
$ deck/dollars="ThEgReAtZaR"
integer*4 function nanjpi()
c
c Do random getjpi on system(needs WORLD privilege)
c
c (c) Zar Ltd. 1985
c
parameter maxwait = '0 0:0:2.0'
implicit integer*4 (a-z)
include 'nanny.inc'
include '($dvidef)'
include '($jpidef)'
include '($ssdef)'
integer*4 dvilist(4),jpilist(55),qwait(2)
integer*4 gpgcnt,ppgcnt
c
c Initialize
c
c_account = ' '
c_authpriv(1) = 0
c_authpriv(2) = 0
c_bufio = 0
c_cpulim = 0
c_cputim = 0
c_dirio = 0
gpgcnt = 0
c_owner = 0
c_pageflts = 0
c_phy_term = ' '
c_pid = 0
ppgcnt = 0
c_prccnt = 0
c_prib = 0
c_ipid = 0
c_sts = 0
c_terminal = ' '
c_uic(1) = 0
c_uic(2) = 0
c_username = ' '
jpilist(1) = jpi$_account *2**16 + 8
jpilist(2) = %loc(c_account)
jpilist(3) = 0
jpilist(4) = jpi$_authpriv *2**16 + 8
jpilist(5) = %loc(c_authpriv)
jpilist(6) = 0
jpilist(7) = jpi$_bufio *2**16 + 4
jpilist(8) = %loc(c_bufio)
jpilist(9) = 0
jpilist(10) = jpi$_cpulim *2**16 + 4
jpilist(11) = %loc(c_cpulim)
jpilist(12) = 0
jpilist(13) = jpi$_cputim *2**16 + 4
jpilist(14) = %loc(c_cputim)
jpilist(15) = 0
jpilist(16) = jpi$_dirio *2**16 + 4
jpilist(17) = %loc(c_dirio)
jpilist(18) = 0
jpilist(19) = jpi$_gpgcnt *2**16 + 4
jpilist(20) = %loc(gpgcnt)
jpilist(21) = 0
jpilist(22) = jpi$_owner *2**16 + 4
jpilist(23) = %loc(c_owner)
jpilist(24) = 0
jpilist(25) = jpi$_pageflts *2**16 + 4
jpilist(26) = %loc(c_pageflts)
jpilist(27) = 0
jpilist(28) = jpi$_pid *2**16 + 4
jpilist(29) = %loc(c_pid)
jpilist(30) = 0
jpilist(31) = jpi$_ppgcnt *2**16 + 4
jpilist(32) = %loc(ppgcnt)
jpilist(33) = 0
jpilist(34) = jpi$_prccnt *2**16 + 2
jpilist(35) = %loc(c_prccnt)
jpilist(36) = 0
jpilist(37) = jpi$_prib *2**16 + 2
jpilist(38) = %loc(c_prib)
jpilist(39) = 0
jpilist(40) = jpi$_proc_index *2**16 + 4
jpilist(41) = %loc(c_ipid)
jpilist(42) = 0
jpilist(43) = jpi$_sts *2**16 + 4
jpilist(44) = %loc(c_sts)
jpilist(45) = 0
jpilist(46) = jpi$_terminal *2**16 + 10
jpilist(47) = %loc(c_terminal)
jpilist(48) = 0
jpilist(49) = jpi$_uic *2**16 + 4
jpilist(50) = %loc(c_uic)
jpilist(51) = 0
jpilist(52) = jpi$_username *2**16 + 12
jpilist(53) = %loc(c_username)
jpilist(54) = 0
jpilist(55) = 0
dvilist(1) = dvi$_tt_phydevnam *2**16 + 10
dvilist(2) = %loc(c_phy_term)
dvilist(3) = 0
dvilist(4) = 0
nanjpi = ss$_normal
c
c Convert MAXWAIT to system time
c
code = sys$bintim(maxwait,qwait)
if (code.ne.ss$_normal) then
nanjpi = ss$_abort
return
end if
c
c Set a timer
c
code = sys$setimr(%val(1),qwait,,%val(3))
if (code.eq.ss$_normal) then
c
c Do the $GETJPI service
c
jpicode = sys$getjpi(%val(2),ranjpipid,,jpilist,,,)
if (jpicode.eq.ss$_normal) code = sys$wflor(%val(1),
1 %val(2**1.or.2**2))
end if
c_wssize = gpgcnt + ppgcnt
if (lench(c_terminal).gt.0) then
if (index(c_terminal,':').eq.0) c_terminal =
1 c_terminal(:len1(c_terminal))//':'
c
c Get the physical terminal name if a terminal field exists
c First cancel the previous timer if its still alive and set a
c new timer
c
code = sys$cantim(%val(3),)
code = sys$setimr(%val(1),qwait,,%val(3))
if (code.eq.ss$_normal) then
c
c Do the $GETDVI service
c
dvicode = sys$getdvi(%val(17),,c_terminal,dvilist,,,,)
if (dvicode.eq.ss$_normal) code = sys$wflor(%val(1),
1 %val(2**1.or.2**17))
end if
end if
c
c Clear R0 and return
c
code = sys$cantim(%val(3),)
nanjpi = jpicode
return
end
subroutine kill(inline,inp_uic,dumy)
C
C Routine to delete, force exit, suspend, or resume a process.
C Both the calling process and the target process must have the
C same UIC.
c
c (c) Zar Ltd. 1985
c
parameter ss$_normal = 1
parameter wait_time = '0 0:0:3.0'
implicit integer*4 (a-z)
include 'nanny.inc'
include '($jpidef)'
character*(*) inline
character*80 message
character*12 userc,usert
character*8 fnction
integer*4 getlis(7),qwait(2)
integer*2 uict(2),uicc(2),inp_uic(2)
logical*1 dumy
C
C Initialize and get command
C
dumy = nan$_invcom
call str$upcase(inline,inline)
if (inline(1:5).ne.'KILL '.and.inline(1:5).ne.'STOP '.and.
1 inline(1:8).ne.'SUSPEND '.and.inline(1:7).ne.'RESUME ') return
i=index(inline,' ')-1
fnction=inline(1:i)
C
C Decode the target Process ID
C
inline=inline(i+2:)
if (lench(inline).eq.0) goto 999
do while(inline(1:1).eq.' ')
inline=inline(2:)
end do
j=index(inline,' ')-1
read(inline(:j),'(z<j>)',err=999) pidt
C
C Try to get the target UIC
C
getlis(1) = jpi$_uic * 2**16 + 4
getlis(2) = %loc(uict)
getlis(3) = 0
getlis(4) = jpi$_username * 2**16 + 12
getlis(5) = %loc(usert)
getlis(6) = 0
getlis(7) = 0
code = sys$bintim(wait_time,qwait)
if (bug(code,'BINTIM').ne.ss$_normal) goto 999
code = sys$setimr(%val(11),qwait,,)
if (bug(code,'SETIMR').ne.ss$_normal) goto 999
code = sys$getjpi(%val(12),pidt,,getlis,,,)
if (bug(code,'GETJPI').ne.ss$_normal) goto 999
code = sys$wflor(%val(11),%val(2**11.or.2**12))
call bug(code,'WFLOR')
C
C Decode the requesting Process ID
C
inline=inline(j+2:)
if (lench(inline).eq.0) goto 999
do while(inline(1:1).eq.' ')
inline=inline(2:)
end do
j=index(inline,' ')-1
read(inline(:j),'(z<j>)',err=999) pidc
C
C Try to get the requesting UIC
C
getlis(1) = jpi$_uic * 2**16 + 4
getlis(2) = %loc(uicc)
getlis(3) = 0
getlis(4) = jpi$_username * 2**16 + 12
getlis(5) = %loc(userc)
getlis(6) = 0
getlis(7) = 0
code = sys$setimr(%val(11),qwait,,)
if (bug(code,'SETIMR').ne.ss$_normal) goto 999
code = sys$getjpi(%val(12),pidc,,getlis,,,)
if (bug(code,'GETJPI').ne.ss$_normal) goto 999
code = sys$wflor(%val(11),%val(2**11.or.2**12))
call bug(code,'WFLOR')
C
C Make sure the requestor's UIC and the mailbox UIC are the same
C
if (inp_uic(1).ne.uicc(1).or.inp_uic(2).ne.uicc(2)) then
write(message,'(a,o3,a,o3,a)') 'System being violated'//
1 ' by UIC [',inp_uic(2),',',inp_uic(1),']'
call output(2,message(:38))
dumy = nan$_nopriv
return
end if
C
C If the two UICs aren't the same, don't delete.
C
if (uicc(2).gt.sysgrp.and.(uicc(1).ne.uict(1).or.uicc(2).ne.
1 uict(2))) goto 888
if (uicc(2).gt.sysgrp.and.(usert.ne.userc.or.pidt.eq.0))
1 goto 888
C
C Delete the target process and raise its priority to make
C sure it goes away.
C
if (fnction.eq.'KILL') then
code = sys$forcex(pidt,,%val('2c'x))
call bug(code,'FORCEX')
code = sys$delprc(pidt,)
if (bug(code,'DELPRC').eq.ss$_normal) then
code = sys$setpri(pidt,,%val(13),)
call bug(code,'SETPRI')
else
goto 999
end if
C
C Force a process to stop execution of the image it's running.
C
else if (fnction.eq.'STOP') then
code = sys$forcex(pidt,,%val('2c'x))
if (bug(code,'FORCEX').ne.ss$_normal) goto 999
C
C Suspend a process
C
else if (fnction.eq.'SUSPEND') then
code = sys$suspnd(pidt,)
if (bug(code,'SUSPND').ne.ss$_normal) goto 999
C
C Resume a process
C
else if (fnction.eq.'RESUME') then
code = sys$resume(pidt,)
if (bug(code,'RESUME').ne.ss$_normal) goto 999
end if
C
C Stamp SYS$OUTPUT with a completion message
C
message = 'Request to '//fnction(:len1(fnction))//' process '//
1 usert(:len1(usert))//' by '//userc(:len1(userc))//' approved'
call output(2,message(:len1(message)))
dumy=1
return
888 message = 'Request to '//fnction(:len1(fnction))//' process '//
1 usert(:len1(usert))//' by '//userc(:len1(userc))//' denied'
call output(1,message(:len1(message)))
dumy = nan$_retwarn
return
999 message = 'Request to '//fnction(:len1(fnction))//' process '//
1 usert(:len1(usert))//' by '//userc(:len1(userc))//' aborted'//
2 ' on error'
call output(1,message(:len1(message)))
return
end
subroutine loop
c
c Be recursive
c
c (c) Zar Ltd. 1985
c
parameter ss$_normal = 1
implicit integer*4 (a-z)
include 'nanny.inc'
include '($iodef)'
external gotmess
c
code = sys$qio(,%val(mbxchan),%val(io$_readvblk),,gotmess,,
1 inbuff,%val(128),,,,)
if (bug(code,'QIO').ne.ss$_normal)
1 call output(2,'Recursive I/O stopped. Input will be ignored')
return
end
c
c Function Lench
c
c This function takes a character string and finds out how long the
c "actual" string is (i.e. not including padded blanks on the right).
c
c (c) Zar Ltd. 1985
c
integer*4 function lench(string)
character*(*) string
character*255 dumy
c
do while(index(string,char(0)).ne.0)
i = index(string,char(0))
string(i:i) = ' '
end do
call str$trim(dumy,string,line_l)
lench = line_l
return
end
c
c=====================================================================
c
subroutine new_log(dumy)
c
c Get parameters for this run from startup file.
c
c (c) Zar Ltd. 1985
c
implicit integer*4 (a-z)
include 'nanny.inc'
character*80 disknams,oprttys,com_file
character*15 onan_prcnam
character*9 dat
character*8 osysaccnam
integer*4 otruewait(2)
logical*1 dumy,opchk
c
c Close the output and reopen it
c
progress = 0
dumy = 32
inquire(unit=6,opened=opchk)
if (opchk) call output(1,'Logfile closed')
open(unit=6,name='SYS$OUTPUT:',carriagecontrol='list',shared,
1 recl=512,status='new')
close(unit=6)
c
c Reread the parameter file
c
open(unit=1,name='NANNY$START:',readonly,shared,err=6,
1 carriagecontrol='list',status='old')
goto 7
6 open(unit=1,name='SYS$INPUT:',readonly,shared,err=3,
1 carriagecontrol='list',status='old')
c
c Get the process name
c
7 read(1,110,err=3,end=3) onan_prcnam
if (nan_prcnam.ne.onan_prcnam) then
code=sys$setprn(onan_prcnam)
call bug(code,'SETPRN')
nan_prcnam=onan_prcnam
end if
progress=progress+1
c
c Get the system group UIC
c
read(1,120,err=3,end=3) osysgrp
if (osysgrp.lt.1.or.osysgrp.gt.255) goto 3
progress=progress+1
c
c Get the system account name
c
read(1,100,err=3,end=3) osysaccnam
if (sysaccnam.ne.osysaccnam) sysaccnam = osysaccnam
progress=progress+1
c
c Get the cycle time
c
read(1,*,err=3,end=3) owaitim
if (owaitim.lt.1000.or.owaitim.gt.30000) goto 3
c
c Convert cycle time to system quadword format
c
k=owaitim
i=float(k)/6000.
k=k-i*6000
j=float(k)/100.
k=k-j*100
dat='0 0:'
l=5
m=0
if (i.gt.9) m=1
write(dat(l:l+m),'(i<m+1>)',err=3) i
l=l+m+2
dat(l-1:l-1)=':'
m=0
if (j.gt.9) m=1
write(dat(l:l+m),'(i<m+1>)',err=3) j
l=l+m+2
dat(l-1:l-1)='.'
m=0
if (k.gt.9) m=1
write(dat(l:l+m),'(i<m+1>)',err=3) k
l=l+m
if (sys$bintim(dat(:l),otruewait).ne.1) goto 3
progress=progress+1
c
c Get the number of cycles to use for CPU use average
c
read(1,*,err=3,end=3) ocpu_average
if (ocpu_average.lt.1.or.ocpu_average.gt.max_average) goto 3
progress=progress+1
c
c Get the maximum idle time for a terminal and the maximum elapsed
c time limit for interactive processes in "cycle" units
c
read(1,*,err=3,end=3) omaxidle,omaxelapsed
if (omaxidle.gt.8640.or.omaxelapsed.gt.86400) goto 3
if ((omaxidle.ne.0.and.omaxidle.lt.3).or.(omaxelapsed.ne.0
1 .and.omaxelapsed.lt.omaxidle)) goto 3
progress=progress+1
c
c Get the minimum time to be considered not idle
c
read(1,*,err=3,end=3) omintim,ominio
if (omintim.lt.0.or.omintim.gt.299) goto 3
if (ominio.lt.0.or.ominio.gt.299) goto 3
progress=progress+1
c
c Get the maximum usable physical memory(guestimate)
c
read(1,*,err=3,end=3) omaxphymem
if (omaxphymem.ne.0.and.(omaxphymem.lt.2048.or.omaxphymem
1 .gt.65536)) goto 3 !Between 1-32 Megabytes of memory
progress=progress+1
c
c Define memory size to resume suspended jobs
c
read(1,*,err=3,end=3) olowphymem
if (olowphymem.ne.0.and.(olowphymem.lt.128.or.olowphymem
1 .gt.65536)) goto 3 !Between 0-32 Meg of memory
if (olowphymem.gt.omaxphymem) olowphymem = omaxphymem
progress=progress+1
c
c Should we purge the working set
c
read(1,140,err=3,end=3) dat
call str$upcase(dat,dat)
purgews = .false.
if (dat(1:1).eq.'1'.or.dat(1:1).eq.'Y'.or.dat(1:1)
1 .eq.'T') purgews = .true.
progress=progress+1
c
c Get the denominator for determining critical disk space availability
c
read(1,*,err=3,end=3) olowdivd
if (olowdivd.le.0.or.olowdivd.gt.200) goto 3
progress=progress+1
c
c Get the disk names to watch
c
read(1,100,err=3,end=3) disknams
i=index(disknams,'!')-1
if (i.gt.0) disknams=disknams(:i)
if (.not.opchk) call dskchk(disknams,.true.)
if (opchk) call dskchk(disknams,.false.)
progress=progress+1
c
c Get the names of the Nanny operator terminals
c
read(1,100,err=3,end=3) oprttys
i=index(oprttys,'!')-1
if (i.gt.0) oprttys=oprttys(:i)
call opr_par(oprttys)
progress=progress+1
c
c Get the disable bit mask
c
read(1,150,err=3,end=3) odisable
progress=progress+1
c
c Get the function enable bit mask
c
read(1,150,err=3,end=3) ofunctmsk
progress=progress+1
c
c Get the names of users to ignore
c
read(1,100,err=3,end=3) com_file
i=index(com_file,'!')-1
if (i.gt.0) com_file=com_file(:i)
do i=1,maxig_user
ig_user(i) = ' '
end do
ig_p = 1
1 continue
if (lench(com_file).gt.0) then
i=index(com_file,',')
if (i.eq.0) i=lench(com_file)+1
ig_user(ig_p)=com_file(:i-1)
ig_p=ig_p+1
com_file=com_file(i+1:)
if (ig_p.le.maxig_user) goto 1
end if
progress=progress+1
c
c Get the names of terminals to ignore
c
read(1,100,err=3,end=3) com_file
i=index(com_file,'!')-1
if (i.gt.0) com_file=com_file(:i)
do i=1,maxig_term
ig_term(i) = ' '
end do
ig_p = 1
2 continue
if (lench(com_file).gt.0) then
i=index(com_file,',')
if (i.eq.0) i=lench(com_file)+1
ig_term(ig_p)=com_file(:i-1)
ig_p=ig_p+1
com_file=com_file(i+1:)
if (ig_p.le.maxig_term) goto 2
end if
progress=progress+1
c
c Group account preference values
c
i = 0
5 read(1,100,end=4) com_file
if (index(com_file,'!').ne.0) com_file = com_file(:index(
1 com_file,'!'))
prefacc(i+1) = com_file(1:8)
com_file = com_file(10:)
if (lench(com_file).eq.0) goto 5
do while(com_file(1:1).eq.' ')
com_file = com_file(2:)
end do
line_l = lench(com_file)
per_loc = index(com_file,'.')
if (per_loc.eq.0) goto 5
read(com_file,'(f<line_l>.<line_l-per_loc+1>)',err=5) prefadd(
1 i+1)
if (prefadd(i+1).eq.-1.1250) prefadd(i+1) = -1.126
i = i + 1
progress=progress+1
goto 5
4 prefadd(i+1) = 101.0
close(unit=1)
c
c Everything went ok, so set the common variables and return
c
sysgrp = osysgrp
waitim = owaitim
cpu_average = ocpu_average
maxidle = omaxidle
maxelapsed = omaxelapsed
mintim = omintim
minio = ominio
truewait(1) = otruewait(1)
truewait(2) = otruewait(2)
maxphymem = omaxphymem
lowphymem = olowphymem
lowdivd = olowdivd
disable = odisable
functmsk = ofunctmsk
dumy = 1
call output(1,'Logfile initialized')
return
3 write(dat,'(i3)') progress+1
call output(2,'Parameter file error on line'//dat)
return
c
c Formats
c
100 format(a)
110 format(a15)
120 format(o3)
130 format(a8)
140 format(a1)
150 format(z8)
end
subroutine oprman(inline,inp_uic,dumy)
C
C This will set a terminl to receive operator messages or
C to terminate operator messages to a terminal(REPLY/ENABLE
C or REPLY/DISABLE).
c
c (c) Zar Ltd. 1985
c
parameter ss$_normal = 1
parameter wait_time = '0 0:0:3.0'
implicit integer*4 (a-z)
include 'nanny.inc'
include '($dvidef)'
include '($iodef)'
include '($jpidef)'
character*(*) inline
character*80 message
character*23 oprmes
character*12 user,term,tty
character*4 funct
integer*4 getlis(10),qwait(2),dvilis(4),unit_num
integer*2 inp_uic(2),uicc(2),unit
integer*2 jbcret
byte tty_l,opc$_rq_terme
logical*1 dumy,edmask(3)
equivalence (opc$_rq_terme,oprmes(1:1))
equivalence (edmask,oprmes(2:4))
equivalence (opc$m_nm_all,oprmes(5:8)),(unit,oprmes(9:10))
equivalence (tty_l,oprmes(11:11)),(tty,oprmes(12:23))
data opc$_rq_terme,opc$m_nm_all/1,'ffffffff'x/
C
dumy = nan$_invcom
call sys$bintim(wait_time,qwait)
C
C Get the function(OEN or ODIS)
C
i=index(inline,' ')+1
funct=inline(1:i-2)
inline=inline(i:)
if (lench(inline).eq.0) goto 999
do while(inline(1:1).eq.' ')
inline=inline(2:)
end do
i=index(inline,' ')+1
C
C Get the process I.D. of the requestor
C
if (lench(inline).eq.0) goto 999
do while(inline(1:1).eq.' ')
inline=inline(2:)
end do
i=index(inline,' ')-1
read(inline(:i),'(z<i>)',err=999) pidc
C
C Get the UIC of the requestor
C
getlis(1) = jpi$_username * 2**16 + 12
getlis(2) = %loc(user)
getlis(3) = 0
getlis(4) = jpi$_uic * 2**16 + 4
getlis(5) = %loc(uicc)
getlis(6) = 0
getlis(7) = jpi$_terminal * 2**16 + 12
getlis(8) = %loc(term)
getlis(9) = 0
getlis(10) = 0
code = sys$setimr(%val(13),qwait,,)
if (bug(code,'SETIMR').ne.ss$_normal) goto 999
code = sys$getjpi(%val(14),pidc,,getlis,,,)
if (bug(code,'GETJPI').ne.ss$_normal) goto 999
code = sys$wflor(%val(13),%val(2**13.or.2**14))
call bug(code,'WFLOR')
C
C Make sure the requestor and the mailbox UICs are the same
C
if (inp_uic(1).ne.uicc(1).or.inp_uic(2).ne.uicc(2)) then
write(message,'(a,o3,a,o3,a)') 'System being violated'//
1 ' by UIC [',inp_uic(2),',',inp_uic(1),']'
call output(2,message(:38))
dumy = nan$_nopriv
return
end if
C
C Cut up the terminal name
C
i=index(term,':')
if (i.eq.0.or.i-4.lt.1) goto 888
if (term(1:1).ne.'_') term='_'//term
tty=term
tty_l=index(tty,':')
C
C Get the unit number
C
dvilis(1)=dvi$_unit*2**16 + 4
dvilis(2)=%loc(unit_num)
dvilis(3)=0
dvilis(4)=0
code = sys$setimr(%val(13),qwait,,)
if (bug(code,'SETIMR').ne.ss$_normal) goto 999
code = sys$getdvi(%val(14),,tty(:tty_l),dvilis,,,,)
if (bug(code,'GETDVI').ne.ss$_normal) goto 999
code = sys$wflor(%val(13),%val(2**13.or.2**14))
call bug(code,'WFLOR')
unit=lib$extzv(0,16,unit_num)
edmask(1)=0
edmask(2)=0
edmask(3)=0
C
C Do the dirty deed
C
if (funct(:3).eq.'OEN') then
edmask(1)=-1
edmask(2)=-1
edmask(3)=-1
code=sys$sndopr(%descr(oprmes(:12+tty_l-1)),%val(mbx2))
if (bug(code,'SNDOPR').ne.ss$_normal) goto 888
else if (funct.eq.'ODIS') then
code=sys$sndopr(%descr(oprmes(:12+tty_l-1)),%val(mbx2))
if (bug(code,'SNDOPR').ne.ss$_normal) goto 888
end if
C
C Read from the mailbox for the completion status
C
code = sys$setimr(%val(13),qwait,,)
if (bug(code,'SETIMR').ne.ss$_normal) goto 888
code = sys$qio(%val(14),%val(mbx2),%val(io$_readvblk),
1 ,,,jbcret,%val(2),,,,)
if (bug(code,'QIO').ne.ss$_normal) goto 888
code = sys$wflor(%val(13),%val(2**13.or.2**14))
call bug(code,'WFLOR')
if (jbcret.ne.0) then
if (bug(jbcret,'SNDOPR').ne.ss$_normal) goto 888
end if
code = sys$cancel(%val(mbx2))
call bug(code,'CANCEL')
C
C We did it! Let's write out a message now.
C
dumy=1
call output(2,'Command '//funct(:len1(funct))//' requested '//
1 'by '//user(:len1(user))//' completed')
return
c
c Error
c
888 code = sys$cancel(%val(mbx2))
call bug(code,'CANCEL')
dumy = nan$_retwarn
999 call output(1,'Command '//funct(:len1(funct))//' requested '//
1 'by '//user(:len1(user))//' aborted')
return
end
ThEgReAtZaR
$ checksum nf2.for
$ if chk.nes.checksum$checksum then write sys$output -
"NF2.FOR didn't pass checksum. File may be corrupted."
$ if chk.nes.checksum$checksum then exit %x2c
$ exit