!***********************************************************************
!*
!*                       User monitoring package
!*
!*      Copyright (C) R.D. Eager   University of Kent   MCMLXXXIII
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!*          Constants
!*
!***********************************************************************
!
constantinteger  no = 0, yes = 1
constantinteger  topaa = 999
constantintegerarray  uar(0:3) = c 
x'06baadbc', x'bccecf07', x'b0afbaad', x'b3b0b8ff'
!
!
!***********************************************************************
!*
!*          Record and array formats
!*
!***********************************************************************
!
recordformat  hf(integer  dataend,datastart,filesize,filetype,sum,
                 datetime,format,records)
recordformat  idf((string (6) user,string (8) date,string (35) s) or  c 
                  (byteinteger  nl,string (5) dum1,byteinteger  sp,
                   string (7) dum2,byteinteger  sp1,string (34) dum3))
recordformat  rf(integer  conad,filetype,datastart,dataend)
recordformat  uf(record (idf) id,(string (3) n or  c 
                 byteinteger  sp,sp1,sp2,sp3))
!
ownrecord (uf)arrayformat  aaf(0:topaa)
!
!
!***********************************************************************
!*
!*          Subsystem references
!*
!***********************************************************************
!
systemroutinespec  connect(string (31) file,integer  mode,hole,
                           prot,record (rf)name  r,integername  flag)
externalstringfunctionspec  date
systemroutinespec  disconnect(string (31) file,integername  flag)
externalstringfunctionspec  uinfs(integer  entry)
!
!
!***********************************************************************
!*
!*          Service routines
!*
!***********************************************************************
!
stringfunction  unscramble(integer  adr)
integer  len
! Encrypts or decrypts the string at 'adr'.
record (string (11) s or  integer  a,b,c) r
!
r = 0
r_s <- string(adr)
len = length(r_s)
r_a = r_a !! (-1)
r_b = r_b !! (-1)
r_c = r_c !! (-1)
length(r_s) = len
result  = r_s
end ;   ! of unscramble
!
!-----------------------------------------------------------------------
!
integerfunction  scomp(stringname  s1,s2,integer  len)
! Comparison from addr(s1)+1, addr(s2)+1 for 'len' bytes.
!          0  if equal
!          1  if not equal
integer  i,len1,len2
!
len1 = length(s1)
len2 = length(s2)
length(s1) = len
length(s2) = len
!
if  s1 = s2 then  i = 0 else  i = 1
!
length(s1) = len1
length(s2) = len2
result  = i
end ;   ! of scomp
!
!-----------------------------------------------------------------------
!
routine  inc(stringname  s)
integer  i,carry,ch
!
i = 3
carry = 1
while  i > 0 cycle 
   ch = charno(s,i)
   ch = ch + carry
   if  ch > '9' then  start 
      ch = '0'
      carry = 1
   finish  else  carry = 0
   charno(s,i) = ch
   i = i - 1
repeat 
end ;   ! of inc
!
!
!***********************************************************************
!*
!*          M O N        
!*
!***********************************************************************
!
systemroutine  mon(string (255) s)
integer  found,n,offset,max,size,idsize,flag
string (6) user
string (8) xdate
string (11) file
record (idf) id
record (rf) rr
record (uf) dum
record (uf)arrayname  aa
record (hf)name  h
!
size = sizeof(dum)
idsize = sizeof(id)
user = unscramble(addr(uar(0)))
file = unscramble(addr(uar(0))+7)
!
connect(user.".".file,11,0,0,rr,flag);  ! Write shared
return  if  flag # 0
!
s = s." " while  length(s) < 35
length(s) = 35 if  length(s) > 35
id_user = uinfs(1)
id_date = date
id_s = s
id_nl = nl
id_sp = ' '
id_sp1 = ' '
!
h == record(rr_conad)
aa == array(rr_conad+rr_datastart,aaf)
offset = h_dataend - 1
max = (offset-h_datastart)//size - 1
!
n = max
found = 0
xdate = date
while  n>=0 and  scomp(aa(n)_id_date,xdate,8) = 0 cycle 
   if  scomp(id_user,aa(n)_id_user,idsize-1) = 0 then  start 
      found = yes
      inc(aa(n)_n)
      exit 
   finish 
   n = n - 1
repeat 
!
if  found = no and  h_filesize - h_dataend > size + 1 then  start 
   h_dataend = h_dataend + size
   byteinteger(rr_conad+h_dataend-1) = nl
   max = max + 1
   aa(max)_id = id
   aa(max)_n = "001"
   aa(max)_sp = ' '
finish 
!
disconnect(user.".".file,flag)
end ;   ! of operlog
endoffile