!******************************************************************************
!
! Friends program
! M.Gray, ERCC
! Modified by R.D. Eager, University of Kent MCMLXXXIV
!
!******************************************************************************
!******************************************************************************
!
! Constants
!
!******************************************************************************
constinteger true = 1,
false = 0
constinteger normal = 0, { normal output mode
forced = 1 { output always sent to terminal
conststring (7) profile key = "Friends"
conststring (1) snl = "
"
!******************************************************************************
!
! Subsystem references
!
!******************************************************************************
dynamicroutinespec write profile (string (11) key, name info,
integername version,flag)
externalroutinespec read profile (string (11) key, name info,
integername version,flag)
systemstringfunctionspec confile(integer ad)
systemroutinespec console (integer ep, integername start, length)
externalintegerfnspec exist (string (31) file)
externalstring (255)fnspec ucstring(string (255) s)
externalintegerfnspec uinfi (integer i)
!******************************************************************************
!
! Director reference
!
!******************************************************************************
externalintegerfnspec Dfsys (string (31) index, integername fsys)
!******************************************************************************
!
! Service Routines
!
!******************************************************************************
routine error(integer number)
constantstring (80)array messages(1:14) =
"INSERT warning: Some characters chopped from NAME",
"INSERT fails: Maximum user count exceeded",
"INSERT fails: User number invalid",
"INSERT fails: Invalid parameter.",
"WHO fails: No names set up in PROFILE",
"REMOVE fails: User number was not inserted",
"REMOVE fails: No user numbers set up",
"REMOVE fails: Invalid user number",
"? fails: No names set up in PROFILE.",
"fails: Invalid option parameter.",
"REMOVE fails: Invalid parameter.",
"INSERT fails: User given does not exist.",
"INSERT Warning : file SS#PROFILE created by friends program.",
"INSERT Fails : Failed to write to profile file."
print string("FRIENDS ".messages(number))
new line
end
routine insert name (string (255) number)
constinteger current version = 1
integer version,flag,index, fsys
string (255) name
record (integer quantity,
string (6) array user number (1:25),
string (31) array user name (1:25)) names and numbers
! There are three different forms of the parameters to insert:
! 1. <jobnumber> , <Alias>
! 2. <jobnumber> , <null>
! 3. <jobnumber>
!
! The last two cases default the value of the alias to the jobnumber.
! Thus first sort out the parameters and set the defaults if needed.
! Fail if null string given as a parameter.
if number -> number.(",").name start
name = number if name = ""; ! case 2
else
name = number
finish
unless number = "" start
if length(number) = 6 then start
fsys = -1; ! dont know users fsys - scan them all
flag = dfsys (number, fsys)
if fsys # -1 start ; ! found the usernumber
if length(name) > 31 then error (1)
number = ucstring(number)
read profile (profile key,names and numbers,version,flag)
if flag > 2 then names and numbers_quantity = 0
if names and numbers_quantity < 25 then start
index = 0
index = index + 1 until index > names and numbers_quantity c
or names and numbers_user number(index) = number
if index > names and numbers_quantity then c
names and numbers_quantity = names and numbers_quantity + 1
names and numbers_user number(index) <- number
names and numbers_user name(index) <- name
version = current version
write profile(profile key,names and numbers,version,flag)
finish else error (2)
if flag = 1 then error (13 { created ss#profile }) elsec
if flag > 1 then error (14); ! failed to write to profile
finish else error (12)
finish else error (3)
finish else error (4)
end
routine print names
integer version,flag,index
record (integer quantity,
string (6) array user number (1:25),
string (31) array user name (1:25)) names and numbers
read profile(profile key,names and numbers,version,flag)
if (flag < 3) and (names and numbers_quantity > 0) then start
for index = 1,1,names and numbers_quantity cycle
print string(names and numbers_user number(index)." ".names and numbers_user name(index))
new line
repeat
finish else error (5)
end
routine remove name(string (255) s)
constinteger current version = 1
integer version,flag,index
string (6) number
record (integer quantity,
string (6) array user number (1:25),
string (31) array user name (1:25)) names and numbers
if length(s) = 6 then start
number <- s
read profile (profile key,names and numbers,version,flag)
if (flag < 3) and (names and numbers_quantity > 0) then start
index = 0
index = index + 1 until index > names and numbers_quantity c
or names and numbers_user number(index) = number
if index <= names and numbers_quantity then start
names and numbers_quantity = names and numbers_quantity - 1
for index = index,1,names and numbers_quantity cycle
names and numbers_user number(index) = names and numbers_user number(index + 1)
names and numbers_user name(index) = names and numbers_user name(index + 1)
repeat
version = current version
write profile (profile key,names and numbers,version,flag)
finish else error (6)
finish else error (7)
finish else error (8)
end
routine print logged on(integer output mode)
routine pstring (string (255) s)
integer len, adr
if output mode = normal or uinfi (2) = 2 start
printstring(s)
else
adr = addr (s) + 1
len = Length (s)
console (10, adr, len)
finish
end
recordformat comf(integer ocptype,ipldev,sblks,sepgs,ndiscs, c
ddtaddr,gpctabsize,gpca,sfctabsize,sfca,sfck,dirsite, c
dcodeda,suplvn,wasklokcorrect,date0,date1,date2, c
time0,time1,time2,epagesize,users,cattad,dqaddr, c
sacport,ocpport,itint,contypea,gpcconfa,fpcconfa,sfcconfa, c
blkaddr,dptaddr,smacs,trans,longinteger kmon, c
integer ditaddr,smacpos,supvsn,pstva,secsfrmn,secstocd, c
sync1dest,sync2dest,asyncdest,maxprocs,inspersec,elaphead, c
commsreca,storeaad,procaad,sfcctad,drumtad,sp0,sp1,sp2,sp3, c
sp4,sp5,sp6,sp7,sp8,sp9, c
lstl,lstb,pstl,pstb,hkeys,hoot,sim,clkx,clky,clkz, c
hbit,slaveoff,inhssr,sdr1,sdr2,sdr3, c
sdr4,sesr,hoffbit,s2,s3,s4,end)
recordformat procf(string (6) user, c
byteinteger incar,category,wsn,runq,active, c
integer actwo,lstad,lamtx,stack,status)
externalintegerfnspec dprocs(integername maxprocs, integer adr)
!
routine deluxe(integer maxprocs)
integerarray friend (1 : 25)
byteintegerarray proclist(0:32*maxprocs)
record (procf) array procaf(0:maxprocs)
record (procf) arrayname proca
integer j,flag, line space, line pos, count
string (40) s
flag=dprocs(maxprocs, addr(proclist(0)))
write(flag,4) and return if flag#0
maxprocs = maxprocs-1
proca==array(addr(proclist(0)),procaf)
integer version,flags,index
record (integer quantity,
string (6) array user number (1:25),
string (31) array user name (1:25)) names and numbers
read profile(profile key,names and numbers,version,flags)
if (flags < 3) and (names and numbers_quantity > 0) then start
line space = Uinfi (15) - 15 { allowed for 'is logged on' }
line pos = 0
count = 0
for index = 1,1,names and numbers_quantity cycle
for j = 0,1,maxprocs cycle
if proca(j)_user=names and numbers_user number(index) andc
proca(j)_status & 4 = 0 { not background } start
count = count + 1
friend (count) = index
finish
repeat
repeat
! Now all the logged on friends have been found, print out their
! names, taking account of the number found and calculating the
! grammer which should be placed between them.
for index = 1, 1, count cycle
!t %if index = 1 %then s = "" %elsec
!t %if index = count %then s = " and " %elsec
!t s = ", "
if index = count then s = "" elsec
if index = count - 1 then s = " and " else s = ", "
s = names and numbers_user name (friend(index)) . s
line pos = line pos + length (s)
if line pos > line space start
s = snl . s
line pos = 0
finish
p string (s)
repeat
if count > 0 start
if count = 1 then s = " is" elsec
s = " are"
pstring(s . " logged on.".snl)
finish
finish else error (9)
end
integer maxprocs
record (comf) name com
com==record(x'80000000'+48<<18)
maxprocs=com_maxprocs
deluxe(maxprocs)
return
end
externalroutine friends (string (255) s)
string (6) option
string (255) parameter
if s -> option.("=").parameter then start
option = ucstring(option)
if option = "INSERT" then insert name(parameter) elsec
if option = "REMOVE" then remove name(parameter) else error (10)
else
s = ucstring(s)
if s = "WHO" then print names elsec
if (s = "?") or (s = "") then print logged on (normal)elsec
if s = "??" then print logged on (forced) elsec
if s = "INSERT" then error (3) elsec
if s = "REMOVE" then error (11) else error (10)
finish
end
endoffile