!TITLE Subsystem maintenance utilities
!
!
! This package is a collection of utility commands which are primarily
! intended for supporting and maintaining the Edinburgh Subsystem.
!
!
! Subjects covered are:
!
! 1 Updating members of pdfiles
! 2 Messages of the day
! 3 Altering the ALERT time
! 4 Subsystem basefiles
! 5 Subsystem option files
! 6 Checking partitioned files
!
!
!
!STOP
!
!
!***********************************************************************
!*
!* Subsystem maintenance utilities
!*
!* Copyright (C) R.D. Eager University of Kent MCMLXXXIII
!*
!***********************************************************************
!
!
!***********************************************************************
!*
!* Constants
!*
!***********************************************************************
!
constantinteger no = 0, yes = 1
!
constantinteger exclude data entries = yes
!
constantinteger background = 0, foreground = 1, both = 2
constantinteger ssobjfiletype = 1
constantinteger sscharfiletype = 3
constantinteger ssoptfiletype = 9
constantinteger alertsize = 27; ! Size of 'alert' part of message of the day
constantinteger segsize = x'00040000'
constantinteger abasefile = x'00800000'
! Address of basefile when loaded
constantinteger abaseobj = x'00800020';! Address of basefile object when loaded
constantbyteinteger em = 25; ! End of file character
constantstring (1) snl = "
"
constantstring (6) owner = "SUBSYS"
constantstring (11) defaultpd = "SYSTEM"
! For UPDATEPD command
constantstring (11) defaultactivedir = "SS#DIR"
constantstring (10) tempdir = "T#TEMPDIR"
constantstring (11)array messagefile(background:both) = c
"BMESSAGE","FMESSAGE","FMESSAGE"
constantstring (8)array opname(background:both) = c
"SETBMESS","SETFMESS","SETBOTH"
constantstring (8) saname = "SETALERT"
!
constantstring (10)array bkeys(1:2) = "BRACKETS","NOBRACKETS"
constantbyteintegerarray bvalues(1:2) = 1,2
constantstring (8)array ekeys(1:3) = "NOECHO","PARTECHO","FULLECHO"
constantbyteintegerarray evalues(1:3) = 0,1,2
constantstring (10)array jkeys(1:3) = "NORECALL","TEMPRECALL","PERMRECALL"
constantbyteintegerarray jvalues(1:3) = 0,1,2
constantstring (12)array lkeys(1:2) = "BLANKLINES","NOBLANKLINES"
constantbyteintegerarray lvalues(1:2) = 0,1
!
constantinteger maxrec = 682; ! BASE records in 8 pages
constantlonginteger descdr = x'b100000000000000'
constantinteger prime = 251
if exclude data entries = no then start
constantinteger data = 1
finish
constantinteger code = 2
!
!
!***********************************************************************
!*
!* Record and array formats
!*
!***********************************************************************
!
recordformat basef(string (31) entry,
(longinteger desc or integer dr0,dr1),
integer type,downlink)
recordformat contf(integer dataend,datastart,psize,filetype,
sum,datetime,sp0,sp1,mark,sp2,sp3,astk,sp4,
sp5,itwidth,ldelim,rdelim,journal,
searchdircount,arraydiag,initworksize,sp6,
itinsize,itoutsize,nobl,istk,
longinteger initparms,integer dataecho,
terminal,i23,i24,i25,i26,i27,i28,i29,i30,i31,
recdiag,
string (31) fstartfile,bstartfile,preloadfile,
moddir,cfaults,cprompt,dprompt,s8,s9,s10,s11,s12,
s13,s14,s15,s16,s17,s18,s19,s20,s21,s22,s23,s24,s25,
s26,s27,s28,s29,s30,s31,s32,
string (31)array searchdir(1:16))
recordformat dirinff(string (6) user,string (31) batchfile,
integer mark,fsys,procno,isuff,reason,batchid,
sessiclim,scidensad,scidens,operno,aiostat,
scdate,sync1dest,sync2dest,asyncdest,aacctrec,
aicrevs,string (15) batchiden,
string (31) basefile,integer previc,itaddr0,
itaddr1,itaddr2,itaddr3,itaddr4,streamid,dident,
scarcity,preemptat,string (11) spoolrfile,
integer resunits,sesslen,priority,decks,drives,
uend)
recordformat ld1f(integer link,loc,string (31) iden)
recordformat ld4f(integer link,disp,l,a,string (31) iden)
recordformat lhf(integer first,last,nbytes)
recordformat hf(integer dataend,datastart,filesize,filetype,
sum,datetime,
(integer format,records or c
integer adir,count or c
integer lda,ofm))
recordformat ofmf(integer start,len,props)
recordformat pdf(integer start,string (11) name,
integer hole,s5,s6,s7)
recordformat rf(integer conad,filetype,datastart,dataend)
!
ownintegerarrayformat ldataf(0:15)
ownintegerarrayformat nlhaf(0:prime-1)
ownrecord (ofmf)arrayformat ofmaf(1:7)
ownrecord (basef)arrayformat basefaf(0:maxrec)
ownrecord (lhf)array lh(0:prime-1)
ownrecord (pdf)arrayformat pdaf(1:4095)
!
!
!***********************************************************************
!*
!* Subsystem references
!*
!***********************************************************************
!
systemroutinespec changeaccess(string (31) file,integer mode,
integername flag)
systemintegermapspec comreg(integer i)
systemroutinespec connect(string (31) file,integer mode,hole,
prot,record (rf)name r,integername flag)
externalstringfunctionspec date
systemroutinespec destroy(string (31) file,integername flag)
systemroutinespec disconnect(string (31) file,integername flag)
systemstringfunctionspec failuremessage(integer mess)
systemroutinespec fill(integer length,from,filler)
systemstringfunctionspec htos(integer value,places)
systemintegerfunctionspec iocp(integer ep,parm)
systemstringfunctionspec itos(integer n)
systemroutinespec moddirfile(integer ep,string (31) dirfile,entry,
filename,integer type,dr0,dr1,
integername flag)
systemroutinespec modpdfile(integer ep,string (31) pdfile,
string (11) member,string (31) infile,
integername flag)
systemroutinespec move(integer length,from,to)
systemroutinespec newgen(string (31) file,newfile,integername flag)
systemstringfunctionspec nexttemp
systemroutinespec outfile(string (31) file,integer size,hole,
prot,integername conad,flag)
externalintegerfunctionspec outpos
systemintegerfunctionspec parmap
systemroutinespec permit(string (31) file,string (6) user,
integer mode,integername flag)
externalroutinespec prompt(string (255) s)
systemintegerfunctionspec pstoi(string (63) s)
systemroutinespec setfname(string (63) s)
systemroutinespec setpar(string (255) s)
externalroutinespec set return code(integer i)
systemroutinespec setwork(integername ad,flag)
systemstringfunctionspec spar(integer n)
systemroutinespec uctranslate(integer ad,len)
externalintegerfunctionspec uinfi(integer entry)
externalstringfunctionspec uinfs(integer entry)
!
externalroutinespec cherish(string (255) s)
externalroutinespec parm(string (255) s)
!
!
!***********************************************************************
!*
!* Service routines
!*
!***********************************************************************
!
stringfunction specmessage(integer flag)
! Yields a local error message.
switch sw(1000:1002)
!
-> sw(flag)
!
sw(1000): result = "Catastrophic failure"
sw(1001): result = "May be used only by ".owner
sw(1002): result = "Entry SSDATELINKED not found"
end ; ! of specmessage
!
!-----------------------------------------------------------------------
!
routine fail(string (15) op,integer flag)
! Prints an error message, and stops.
selectoutput(0)
printstring(snl.op." fails -")
if flag < 1000 then start
printstring(failuremessage(flag))
else
printstring(" ".specmessage(flag).snl)
finish
set return code(flag)
stop
end ; ! of fail
!
!-----------------------------------------------------------------------
!
routine checkuser(string (15) op)
if uinfs(1) # owner then fail(op,1000)
end ; ! of checkuser
!
!-----------------------------------------------------------------------
!
routine readline(stringname s)
integer c
!
on event 9 start
s = tostring(em)
c = iocp(12,0); ! Clear 'Input Ended'
return
finish
!
s = ""
cycle
readsymbol(c)
exit if c = nl
s <- s.tostring(c)
repeat
!
while length(s) > 0 cycle
if charno(s,length(s)) # ' ' then exit
length(s) = length(s) - 1
repeat
end ; ! of readline
!
!-----------------------------------------------------------------------
!
integerfunction getval(string (255) pr,integer min,max,default,mult)
integer i,j
string (255) s
!
j = default
if j & x'3ff' = 0 then start
j = j >> 10
s = "K"
finish else s = ""
prompt(pr." [".itos(j).s."]: ")
!
cycle
readline(s)
result = default if s = ""
i = pstoi(s)
if i < 0 then start
printstring("Invalid number".snl)
continue
finish
i = i*mult
if min <= i <= max then result = i
printstring("Number outside permitted range".snl)
repeat
end ; ! of getval
!
!-----------------------------------------------------------------------
!
integerfunction get setting(string (255) pr,integer nsettings,
stringarrayname keys,
byteintegerarrayname values,
string (31) default)
integer i
string (255) s
!
prompt(pr." [".default."]: ")
cycle
readline(s)
uctranslate(addr(s)+1,length(s))
s = default if s = ""
for i = 1,1,nsettings cycle
if s = keys(i) then result = values(i)
repeat
printstring("Invalid setting".snl)
repeat
end ; ! of get setting
!
!-----------------------------------------------------------------------
!
string (255)function getstr(string (255) pr,integer maxlen,
string (255) default)
string (255) s
!
cycle
prompt(pr." [".default."]: ")
readline(s)
uctranslate(addr(s)+1,length(s))
if s = "." then result = ""
result = default if s = ""
if length(s) <= maxlen then result = s
printstring("Reply must not exceed ".itos(maxlen)." characters".snl)
repeat
end ; ! of getstr
!
!-----------------------------------------------------------------------
!
integerfunction roundup(integer n,r)
r = r - 1
result = (n+r) & (¬r)
end ; ! of roundup
!
!-----------------------------------------------------------------------
!
routine connect or create(string (11) file,record (rf)name rr,
string (15) op)
integer flag,conad
record (hf)name r
!
connect(file,1,0,0,rr,flag)
if flag = 218 then start ; ! File does not exist - create it
printstring("There is no ".file." file".snl)
printstring("It is being created".snl.snl)
outfile(file,4096,0,0,conad,flag)
if flag = 0 then start
r == record(conad)
r_filetype = sscharfiletype
permit(file,"",1,flag); ! Set EEP = R
cherish(file)
fill(alertsize-1,conad+r_datastart,' ')
byteinteger(conad+r_datastart+alertsize-1) = nl
r_dataend = r_datastart + alertsize
finish
connect(file,1,0,0,rr,flag)
finish
if flag # 0 then fail(op,flag)
end ; ! of connect or create
!
!-----------------------------------------------------------------------
!
routine printmessage(integer conad,string (7) type)
integer i,j
record (hf)name r
!
r == record(conad)
j = r_datastart + alertsize
if j >= r_dataend then start
printstring("The ".type." message is null".snl)
else
printstring("The ".type." message is:-".snl.snl)
for i = conad+j,1,conad+r_dataend-1 cycle
printsymbol(byteinteger(i))
repeat
finish
newline
end ; ! of print message
!
!-----------------------------------------------------------------------
!
routine setmessage(stringname parms,integer type,mode)
integer flag,conad,count,j
string (11) file,tempfile
string (15) op
string (255) line
record (rf) rr
record (hf)name r
!
set return code(1000)
file = messagefile(type)
op = opname(mode)
checkuser(op)
!
setpar(parms)
if parmap # 0 then start
flag = 263; ! Wrong number of parameters
-> err
finish
!
connect or create(file,rr,op)
printmessage(rr_conad,"current")
!
tempfile = "T#".nexttemp
cycle
printstring("Type new message - terminated by :".snl)
!
loop:
prompt("Message: ")
outfile(tempfile,4096,0,0,conad,flag)
-> err if flag # 0
r == record(conad)
r_filetype = sscharfiletype
move(alertsize,rr_conad+rr_datastart,conad+r_datastart)
count = r_datastart + alertsize
cycle
readline(line)
exit if line = ":" or line = "*" or line = tostring(em)
if length(line) = 255 then length(line) = 254
line = line.snl
j = length(line)
if count + j >= r_filesize then start
printstring("Message too long - try again".snl)
-> loop
finish
move(j,addr(line)+1,conad+count)
count = count + j
repeat
r_dataend = count
printmessage(conad,"new")
prompt("OK? ")
readline(line) until line # ""
uctranslate(addr(line)+1,1)
exit if charno(line,1) = 'Y'
repeat
!
newgen(tempfile,file,flag)
-> err if flag # 0
printstring("New ".file." in use".snl)
set return code(0)
return
!
err:
fail(op,flag)
end ; ! of setmessage
!
!-----------------------------------------------------------------------
!
integerfunction hash(string (31) name,integer hashconst)
! Hash function for new style directories.
integer a,j,w,l,a1,a2
!
a = addr(name)
l = byteinteger(a)
if l > 8 then start ; ! Close up last 4 to first 4
a1 = a + 5
a2 = a + l - 3
byteinteger(a1+j) = byteinteger(a2+j) for j = 3,-1,0
finish else name = name."<>#@!+&"
w = byteinteger(a+1)*71+byteinteger(a+2)*47+byteinteger(a+3)*97+ c
byteinteger(a+4)*79+byteinteger(a+5)*29+byteinteger(a+6)*37+ c
byteinteger(a+7)*53+byteinteger(a+8)*59
result = w - (w//hashconst)*hashconst
end ; ! of hash
!
!-----------------------------------------------------------------------
!
routine makeoldbasedir(string (31) basefile,tempdir,integername flag)
integer type,dirlength
record (rf) rr
record (hf)name h
integerarray base(0:7)
!
moddirfile(10,tempdir,"","",0,759,1164,flag)
! Create directory
-> err if flag # 0
connect(tempdir,1,0,0,rr,flag)
-> err if flag # 0
h == record(rr_conad)
dirlength = h_filesize
!
connect(basefile,1,0,0,rr,flag)
-> err if flag # 0
!
! Set BASE(2) to the address of the base GLA, forming a pseudo object
! file map
!
if exclude data entries = yes then type = 4 else type = 7
base(2) = roundup(abasefile+rr_dataend+dirlength,segsize)
moddirfile(type,tempdir,"",basefile."_BASEOBJECT",0,addr(base(1)),0,flag)
err:
end ; ! of makeoldbasedir
!
!-----------------------------------------------------------------------
!
routine makenewbasedir(string (31) basefile,tempdir,integername flag)
integer i,freead,j,bgla,l,len8,nextfree,ichain,objconad,link,ad,len
integer ntot,nreq,nconad,conad
record (rf) rr
record (hf)name h
record (ld1f)name ld1
record (basef)arrayname base
record (ofmf)arrayname ofm
integerarrayname ldata,nlh
if exclude data entries = no then start
longinteger desc
record (ld4f)name ld4
finish
!
connect(basefile."_BASEOBJECT",1,0,0,rr,flag)
return if flag # 0
objconad = rr_conad
h == record(objconad)
ldata == array(objconad+h_lda,ldataf)
ofm == array(objconad+h_ofm+4,ofmaf)
bgla = abaseobj + ofm(2)_start; ! GLAP base
!
conad = 0
setwork(conad,flag)
-> err if flag # 0
h == record(conad)
fill(x'7fd0',conad+h_datastart,x'ff')
base == array(conad+h_datastart,basefaf)
nextfree = 0
for i = 0,1,prime-1 cycle
lh(i) = 0
lh(i)_first = -1
repeat
!
! Code entries
!
link = ldata(1)
while link # 0 cycle
ld1 == record(objconad+link)
l = hash(ld1_iden,prime)
len8 = (length(ld1_iden)+9) & x'fffffff8'
! 1 for type byte, 1 for length byte
! + 7 for double word aligning
lh(l)_nbytes = lh(l)_nbytes + len8 + 8
if nextfree > maxrec then start
flag = 291; ! Too many entries
-> err
finish
base(nextfree)_entry = ld1_iden
!
base(nextfree)_desc = descdr!(ld1_loc & x'00ffffff') + bgla
base(nextfree)_type = code
if lh(l)_first < 0 then start
lh(l)_first = nextfree
lh(l)_last = nextfree
lh(l)_nbytes = lh(l)_nbytes + 8; ! For double word terminator
else
ichain = lh(l)_last
base(ichain)_downlink = nextfree
lh(l)_last = nextfree
finish
nextfree = nextfree + 1
link = ld1_link
repeat
!
! Data entries
!
if exclude data entries = no then start
link = ldata(4)
while link # 0 cycle
ld4 == record(objconad+link)
l = hash(ld4_iden,prime)
len8 = (length(ld4_iden)+9) & x'fffffff8'
lh(l)_nbytes = lh(l)_nbytes + len8 + 8
if nextfree > maxrec then start
flag = 291; ! Too many entries
-> err
finish
base(nextfree)_entry = ld4_iden
desc = ld4_l
desc = (desc<<32)!ld4_disp
base(nextfree)_desc = desc
base(nextfree)_type = data
if lh(l)_first < 0 then start
lh(l)_first = nextfree
lh(l)_last = nextfree
lh(l)_nbytes = lh(l)_nbytes + 8
! For double word terminator
else
ichain = lh(l)_last
base(ichain)_downlink = nextfree
lh(l)_last = nextfree
finish
nextfree = nextfree + 1
link = ld4_link
repeat
finish
!
! Now find out how much space required for directory
!
ntot = 1040; ! 32 for headers, 1008 for listheads
ntot = ntot + lh(i)_nbytes for i = 0,1,prime-1
nreq = roundup(ntot,4096); ! Page aligned
printstring(basefile."_BASEOBJECT contains ".itos(nextfree))
printstring(" entries requiring a ".itos(nreq>>12)." page directory".snl)
nextfree = nextfree - 1
!
! Create temp dir
!
outfile(tempdir,nreq,0,0,nconad,flag)
-> err if flag # 0
h == record(nconad)
h_dataend = ntot
nlh == array(nconad+h_datastart,nlhaf)
freead = nconad + 1040; ! First 8 aligned byte for chains
for i = prime-1,-1,0 cycle
unless lh(i)_first < 0 then start
nlh(i) = freead - nconad; ! Offset from start of file
j = lh(i)_first
while j >= 0 cycle
ad = addr(base(j)_entry)
len = byteinteger(ad)
move(len+1,ad,freead); ! Move entry name
byteinteger(freead+len+1) = base(j)_type
freead = (freead+len+9) & x'fffffff8'
! Double word align - +1 for type
longinteger(freead) = base(j)_desc
freead = freead + 8
j = base(j)_downlink
repeat
longinteger(freead) = 0; ! Chain terminator
freead = freead + 8
finish
repeat
!
err:
end ; ! of makenewbasedir
!
!
!***********************************************************************
!*
!* U P D A T E P D
!*
!***********************************************************************
!
!<Updating members of pdfiles
!
! The command UPDATEPD is used to add a new member to, update an
! existing member in, or delete a member from, a pdfile which may be in
! use by other processes.
!
! The command takes the form:
!
! UPDATEPD(pdfile_member,option)
!
! where:-
!
! pdfile_member - specifies the member to be operated on
! option - if null, the member must already exist
! - if N, the member must not already
! exist
! - if D, the old member is simply deleted
!
!
!
!
!
! It is assumed that any file which is to be a replacement for a member
! has the same name as the member itself, and resides in the same
! process.
!
! Since the most common use of this utility is to update members of
! SUBSYS.SYSTEM, the pdfile part of the parameter defaults to SYSTEM.
!>
!
externalroutine updatepd(string (255) parms)
integer flag,conad,savedt,option
string (11) member,tempfile
string (31) file,s
record (rf) rr
record (hf)name ir,or
!
set return code(1000)
setpar(parms)
if 1 # parmap # 3 then start
flag = 263; ! Wrong number of parameters
-> err
finish
if parmap & 2 # 0 then start
s <- spar(2)
if "D" # s # "N" then start
setfname(s)
flag = 202; ! Invalid parameter
-> err
finish
option = charno(s,1)
finish else option = 'Z'; ! Dummy value
s <- spar(1)
unless s -> file.("_").member then start
setfname(parms)
flag = 202; ! Invalid parameter
-> err
finish
!
if file = "" then file = defaultpd
!
unless option = 'D' then start
connect(member,1,0,0,rr,flag)
-> err if flag # 0
finish
connect(file."_".member,1,0,0,rr,flag)
-> err if flag # 0 and option # 'N'
if flag = 0 and option = 'N' then start
flag = 287; ! Member already exists
-> err
finish
connect(file,1,0,0,rr,flag)
-> err if flag # 0
ir == record(rr_conad)
!
! Make temporary copy of pdfile
!
tempfile = "T#".nexttemp
outfile(tempfile,ir_filesize,0,0,conad,flag)
-> err if flag # 0
or == record(conad)
savedt = or_datetime; ! Save creation date over copy
move(ir_filesize,rr_conad,conad); ! Take the copy
or_datetime = savedt; ! Restore date
!
! Delete any existing copy of member. Ignore failures, except in the
! case of the 'D' option.
!
modpdfile(2,tempfile,member,"",flag)
if flag # 0 and option = 'D' then -> err
!
! Insert new copy of member if appropriate
!
modpdfile(1,tempfile,member,member,flag) unless option = 'D'
-> err if flag # 0
!
! Put new copy of pdfile into service
!
newgen(tempfile,file,flag)
-> err if flag # 0
printstring("Member ".file."_".member)
if option = 'D' then s = "destroyed"
if option = 'N' then s = "inserted"
if option = 'Z' then s = "replaced"
printstring(" ".s.snl)
set return code(0)
stop
!
err:
fail("UPDATEPD",flag)
end ; ! of updatepd
!
!
!***********************************************************************
!*
!* S E T F M E S S
!*
!***********************************************************************
!
!<Messages of the day
!
!
! Three commands are provided to alter the 'messages of the day' which
! are displayed at process start-up. These are described in the
! following Sections:
!
!
!<Changing the foreground message
!
!
!
! The command SETFMESS is used to change the 'message of the day'
! displayed to foreground users when they log on. This special command
! is necessary to avoid problems if the file is currently in use, and to
! avoid disturbing the first line of the message, which always carries
! the date and time of the most recent ALERT text.
!
! SETFMESS takes no parameters. The user is prompted for the message,
! which should be terminated by a colon (:) on a line on its own. An
! opportunity is then given to amend the message if it is not
! satisfactory.
!>
!
externalroutine setfmess(string (255) parms)
setmessage(parms,foreground,foreground)
end ; ! of setfmess
!
!
!***********************************************************************
!*
!* S E T B M E S S
!*
!***********************************************************************
!
!<Changing the background message
!
!
!
! The command SETBMESS is used to change the 'message of the day'
! displayed to background users when their job starts. This special
! command is necessary to avoid problems if the file is currently in
! use, and to avoid disturbing the first line of the message, which
! always carries the date and time of the most recent ALERT text.
!
! SETBMESS takes no parameters. The user is prompted for the message,
! which should be terminated by a colon (:) on a line on its own. An
! opportunity is then given to amend the message if it is not
! satisfactory.
!>
!
externalroutine setbmess(string (255) parms)
setmessage(parms,background,background)
end ; ! of setbmess
!
!
!***********************************************************************
!*
!* S E T B O T H
!*
!***********************************************************************
!
!<Changing both messages
!
!
!
! The command SETBOTH is used to change both 'messages of the day'
! displayed to users on process start-up. This special command is
! necessary to avoid problems if the file is currently in use, and to
! avoid disturbing the first line of the message, which always carries
! the date and time of the most recent ALERT text.
!
! SETBOTH takes no parameters. The user is prompted for the message,
! which should be terminated by a colon (:) on a line on its own. An
! opportunity is then given to amend the message if it is not
! satisfactory.
!>
!>
!
externalroutine setboth(string (255) parms)
integer flag,conad
string (11) tempfile
record (rf) rr
!
setmessage(parms,foreground,both)
!
tempfile = "T#".nexttemp
connect(messagefile(foreground),1,0,0,rr,flag)
-> err if flag # 0
outfile(tempfile,4096,0,0,conad,flag)
-> err if flag # 0
move(4096,rr_conad,conad)
!
newgen(tempfile,messagefile(background),flag)
-> err if flag # 0
!
printstring("New ".messagefile(background)." in use".snl)
set return code(0)
stop
!
err:
fail(opname(both),flag)
end ; ! of setboth
!
!
!***********************************************************************
!*
!* S E T A L E R T
!*
!***********************************************************************
!
!<Altering the ALERT time
!
!
!
! The command SETALERT is used to alter the date and time given in the
! 'Latest ALERT' message which forms a permanent part of the message of
! the day, for both foreground and background users.
!
! SETALERT takes up to two parameters:-
!
! 1) The time to be used in the message. Exactly four characters are
! expected, i.e.: hhmm. If this parameter is omitted, a prompt is
! issued for it.
!
! 2) The date to be used in the message. Standard EMAS date format is
! assumed, i.e.: dd/mm/yy. If this parameter is omitted, the
! current date is assumed.
!>
!
externalroutine setalert(string (255) parms)
integer conad,i,savedt,flag
string (11) file,tempfile
string (255) astring,d,t
record (rf) rr
record (hf)name or
!
set return code(1000)
checkuser(saname)
setpar(parms)
if parmap > 3 then start
flag = 263; ! Wrong number of parameters
-> err
finish
t = spar(1)
d = spar(2)
if d = "" then d = date
if length(d) # 8 then start
setfname(d)
flag = 202; ! Invalid parameter
-> err
finish
cycle
if t = "" then start
prompt("Time: ")
readline(t) until t # ""
finish
if length(t) = 4 then exit
printstring("Invalid time".snl)
t = ""
repeat
astring = "Latest ALERT=".d." ".t.snl
!
for i = background,1,foreground cycle
file = messagefile(i)
connect or create(file,rr,saname)
tempfile = "T#".nexttemp
outfile(tempfile,4096,0,0,conad,flag)
-> err if flag # 0
or == record(conad)
savedt = or_datetime; ! Save creation date over copy
move(4096,rr_conad,conad); ! Take the copy
or_datetime = savedt; ! Restore date
move(alertsize,addr(astring)+1,conad+or_datastart)
newgen(tempfile,file,flag)
-> err if flag # 0
repeat
printstring(astring.snl)
set return code(0)
stop
!
err:
fail(saname,flag)
end ; ! of setalert
!
!
!***********************************************************************
!*
!* M A K E B A S E F I L E
!*
!***********************************************************************
!
!<Subsystem basefiles
!
!
!
! The subsystem resides in a file which is commonly called the
! 'basefile'.
!
! This Section describes the structure of the basefile, and how to
! create a new one.
!
!
!
!<Basefile structure
!
!
! The basefile for the subsystem is a partitioned file which contains
! three members:
!
! a) The subsystem object file, with the code fixed up (using the FIX
! utility) to start at segment 32, and the GLA fixed up to start at
! the next free segment after the code.
!
! b) A default 'option' file, connected and used in the absence of the
! user's own option file. When the user sets a non-default option, a
! copy of the default file is made (as SS#OPT), and the modified
! option included in the copy.
!
! c) A directory file, containing the entry points found in the
! subsystem object file. This is the first directory searched by the
! loader.
!>
!<The MAKEBASEFILE command
!
!
! This command takes up to four parameters. These are:
!
!
! 1) The name of the subsystem object file to be used for input.
!
! 2) The name of the default option file to be included in the completed
! basefile.
!
! 3) The destination of the completed basefile.
!
! 4) The type of loader used by the basefile. Possible values are:
!
! OLD or NEW
!
! If any of these parameters is omitted, a prompt is issued for it.
!>
!>
!
externalroutine makebasefile(string (255) parms)
integer flag,objconad,link,glastart
string (3) loadertype
string (31) baseobject,optionfile,basefile
record (rf) rr
integerarrayname ldata
record (dirinff)name dirinf
record (ld4f)name ld4
record (hf)name h
record (ofmf)arrayname ofm
!
set return code(1000)
setpar(parms)
if parmap > 7 then start
flag = 263; ! Wrong number of parameters
-> err
finish
!
baseobject = spar(1)
optionfile = spar(2)
basefile = spar(3)
!
prompt("Object file: ")
readline(baseobject) while baseobject = ""
prompt("Option file: ")
readline(optionfile) while optionfile = ""
prompt("Basefile: ")
readline(basefile) while basefile = ""
prompt("Loader: ")
cycle
readline(loadertype)
uctranslate(addr(loadertype)+1,length(loadertype))
repeat until loadertype = "OLD" or loadertype = "NEW" or loadertype = tostring(em)
!
destroy(basefile,flag); ! Ignore flag
modpdfile(4,basefile,"","",flag); ! Create empty pdfile
-> err if flag # 0
!
connect(baseobject,1,0,0,rr,flag)
-> err if flag # 0
if rr_filetype # ssobjfiletype then start
setfname(baseobject)
flag = 267; ! Invalid filetype
-> err
finish
modpdfile(1,basefile,"BASEOBJECT",baseobject,flag)
! Insert member - order is critical
-> err if flag # 0
!
connect(optionfile,1,0,0,rr,flag)
-> err if flag # 0
if rr_filetype # ssoptfiletype then start
setfname(optionfile)
flag = 267; ! Invalid filetype
-> err
finish
modpdfile(1,basefile,"OPTIONFILE",optionfile,flag)
! Insert member
-> err if flag # 0
!
destroy(tempdir,flag); ! Ignore flag
!
if loadertype # "NEW" then start
makeoldbasedir(basefile,tempdir,flag)
else
makenewbasedir(basefile,tempdir,flag)
finish
!
-> err if flag # 0
!
! Copy directory into basefile
!
modpdfile(1,basefile,"BASEDIR",tempdir,flag)
-> err if flag # 0
destroy(tempdir,flag); ! Ignore flag
!
! Now locate the external integer SSDATELINKED, and fill in the version
! of the current system call table in Director
!
dirinf == record(uinfi(10))
connect(basefile."_BASEOBJECT",1,0,0,rr,flag)
-> err if flag # 0
changeaccess(basefile,3,flag); ! To write to member
-> err if flag # 0
objconad = rr_conad
h == record(objconad)
ofm == array(objconad+h_ofm+4,ofmaf); ! Object file map
glastart = ofm(2)_start
ldata == array(objconad+h_lda,ldataf)
link = ldata(4)
while link # 0 cycle ; ! Search data entry list
ld4 == record(objconad+link)
if ld4_iden = "SSDATELINKED" then start
integer(objconad+glastart+ld4_disp) = dirinf_scdate
integer(objconad) = x'1b800010'; ! Jump over header of BASEOBJECT
-> found
finish
link = ld4_link
repeat
flag = 1002
-> err
!
found:
disconnect(basefile,flag)
set return code(0)
stop
!
err:
fail("MAKEBASEFILE",flag)
end ; ! of makebasefile
!
!
!***********************************************************************
!*
!* M A K E O P T I O N F I L E
!*
!***********************************************************************
!
!<Subsystem option files
!
!
! The subsystem makes use of a file containing 'options' set by the user
! to tailor his process to his own needs. This Section describes how the
! initial option file used by the Subsystem is created, and explains the
! entries in it.
!
!
!<Making the file
!
! The command MAKEOPTIONFILE takes a single parameter, which is the name
! of the option file to be generated. If this parameter is omitted, a
! prompt is issued for it.
!
! A series of prompts is then issued. A value for the appropriate option
! may then be given, or the default setting invoked by simply typing
! 'return'.
! The default setting is displayed in brackets as part of the prompt.
!
! The only exception to all this is the initial PARM setting - see
! Section 5.2.1.
!>
!<Description of options
!
!
!
!
!
! Some of the values stored in the option file are integers, and others
! are strings. Generally, they describe items such as the size of a
! particular workfile, terminal characteristics, directory search lists,
! etc.
!
!
! The rest of this Section describes each option in detail.
!
!PAGE
!
!<Initial PARM setting
!
! The value of this option is made the current PARM setting at log-on.
! MAKEOPTIONFILE uses the value actually in force when the option file
! is being created, as this saves it from having to decode large numbers
! of PARM keywords.
!>
!<Auxiliary stack size
!
! The auxiliary stack is a separate file which is used to store large
! data areas in user programs, due to the limitations on the size of the
! run-time stack in the ICL 2900 series.
!
! Keyword: AUXSTACKSIZE
!
! Default value: 128 Kbytes
!>
!<Initialised stack size
!
! The initialised stack is a pre-allocated part of the user stack. It
! must be at least 32 Kbytes smaller than the user stack as a whole. It
! is used as a data area by FORTRAN programs, but need only be
! pre-allocated if it is intended to load FORTRAN programs from other
! programs.
!
! Keyword: INITSTACKSIZE
!
! Default value: 100 Kbytes
!>
!<Interactive terminal width
!
! Subsystem commands such as ANALYSE and FILES assume the terminal width
! given by this option when planning their output.
!
! Keyword: ITWIDTH
!
! Default value: 80
!>
!<Array diagnostic level
!
! When a diagnostic traceback is given for a program, the number of
! elements of each array which are actually printed is given by this
! option.
!
! Keyword: ARRAYDIAG
!
! Default value: 10
!>
!<Record diagnostic level
!
! When a diagnostic traceback is given for a program, the number of
! items in each record which are actually printed is given by this
! option.
!
! Keyword: RECDIAG
!
! Default value: 10
!>
!<The session workfile
!
! Many subsystem commands (particularly the compilers) make use of a
! common workfile. The size of the workfile is determined by this option
! setting.
!
! Keyword: INITWORKSIZE
!
! Default value: 256 Kbytes
!>
!<Interactive terminal buffers
!
! The subsystem requires two buffers for interactive terminal I/O. One
! is used solely for input, and the other solely for output. Two
! options are provided in order that the sizes of these buffers may be
! altered.
!
! Keyword (input): ITINSIZE
!
! Default value (input) : 1 Kbyte
!
!
! Keyword (output): ITOUTSIZE
!
! Default value (output): 3 Kbytes
!
!>
!<Terminal type
!
! The terminal/screen control package (used by screen editors, etc.)
! uses this option to determine how an interactive terminal is to be
! driven.
!
! In general, this option will not be set by means of the OPTION
! command, although the keyword TERMINAL is provided. It is expected
! that users will select the appropriate terminal type (which is an
! integer) by means of a special command.
!
! The default value supplied is zero, which should correspond to
! 'unspecified video'.
!
!>
!<Brackets/Nobrackets
!
! There are two different command formats which are accepted by the
! subsystem:
!
! a) Spaces in commands are not significant, and any parameters must be
! enclosed in brackets.
!
! b) Spaces in commands are not allowed, since one or more spaces are
! used to separate the command from its parameters, which should not
! be enclosed in brackets.
!
! The actual format accepted depends on this option.
!
! Keywords: BRACKETS and NOBRACKETS
!
! Default value: BRACKETS
!
!>
!<Recall of terminal I/O
!
! The subsystem provides facilities for storing and retrieving
! transactions on an interactive terminal. The three possible values for
! this option are:
!
! NORECALL - nothing is stored
! TEMPRECALL - the current session is stored
! PERMRECALL - the last few sessions are stored
!
! Default value: TEMPRECALL
!>
!<Suppression of blank lines
!
! This option is provided to enable all blank lines output to the
! terminal to be suppressed.
!
! Keywords: BLANKLINES and NOBLANKLINES
!
! Default value: BLANKLINES
!>
!<Echoing of OBEY files
!
! When an OBEY file is being processed, the subsystem may or may not
! 'echo' the resulting transactions on the user's terminal. This option
! controls the amount echoed. The possible settings are:
!
! NOECHO - nothing at all is echoed
! PARTECHO - only 'Command:' lines are echoed
! FULLECHO - all input is echoed, including program input
!
! Default value: PARTECHO
!
! Batch jobs are treated by the subsystem as if they are effectively
! OBEY files for the purposes of this option.
!>
!<Foreground start-up file
!
! This option allows the user to nominate a file of commands which are
! to be OBEYed on foreground process start-up.
!
! Keywords: NOFSTARTFILE and FSTARTFILE
!
! Default value: NOFSTARTFILE
!>
!<Background start-up file
!
! This option allows the user to nominate a file of commands which are
! to be OBEYed on background process start-up.
!
! Keywords: NOBSTARTFILE and BSTARTFILE
!
! Default value: NOBSTARTFILE
!>
!<Pre-loading file
!
! This option allows the user to nominate object files which are to be
! 'pre-loaded' on process start-up. It is not currently implemented.
!>
!<Active directory
!
! This option selects the file which is to be used as the 'active
! directory' for the INSERT and REMOVE commands, and associated actions.
! This is the first user directory searched by the loader, immediately
! after searching the session directory (see Section 4.1).
!
! Keyword: ACTIVEDIR
!
! Default value: SS#DIR
!>
!<Compiler fault file
!
! This option allows the user to select another file, in addition to the
! compiler listing file, to which compilation fault messages may be
! sent. A value of '.NULL' is equivalent to a null string (NOCFAULTS).
!
! Keyword: CFAULTS
!
! Default value: .OUT
!>
!<Command prompt
!
! This option allows the user to select an alternative prompt for
! commands solicited by the Subsystem. The maximum length is 31
! characters.
!
! Keyword: CPROMPT
!
! Default value: Command:
!>
!<Data prompt
!
! This option allows the user to select an alternative default prompt
! for data solicited by user programs. The maximum length is 31
! characters.
!
! Keyword: DPROMPT
!
! Default value: Data:
!>
!<Search directories
!
! Up to 16 additional directories may be added to the search list for a
! process. They are searched immediately after the active directory.
!
! Keywords: SEARCHDIR and REMOVEDIR
!
! Default value: No search directories
!>
!>
!>
!
externalroutine makeoptionfile(string (255) parms)
integer flag,conad,i
string (31) file
string (255) s
record (contf)name c
!
set return code(1000)
setpar(parms)
if parmap > 1 then start
flag = 263; ! Wrong number of parameters
-> err
finish
file <- spar(1)
if file = "" then start
prompt("Option file: ")
readline(file)
finish
!
outfile(file,4096,0,0,conad,flag)
-> err if flag # 0
c == record(conad)
c_dataend = 4096
c_filetype = ssoptfiletype
!
fill(c_dataend-c_datastart,conad+c_datastart,x'ff')
! Fill whole file with -1
fill(5*32,conad+c_datastart+128,0); ! Clear used strings
fill(16*32,addr(c_searchdir(1)),0); ! Set all search directories to null
c_mark = 4; ! Mark four option file format
!
! Fill in the installation-dependent values
!
c_initparms = longinteger(addr(comreg(27)))
printstring("Init "); parm("?")
c_astk = getval("Aux stack",64<<10,1024<<10,128<<10,1024)
c_istk = getval("Init stack",0,((252-32)<<10),100<<10,1024)
c_itwidth = getval("IT width",20,132,80,1)
c_arraydiag = getval("Arraydiag",0,1000,10,1)
c_recdiag = getval("Recdiag",0,1000,10,1)
c_initworksize = getval("Initworksize",256<<10,1024<<10,256<<10,1024)
c_itinsize = getval("IT insize",1<<10,16<<10,1<<10,1024)
c_itoutsize = getval("IT outsize",1<<10,16<<10,3<<10,1024)
c_terminal = getval("Terminal",-1,100,4,1)
!
flag = get setting("(No)Brackets",2,bkeys,bvalues,"BRACKETS")
if flag = 1 then start
c_ldelim = '('
c_rdelim = ')'
else
c_ldelim = ' '
c_rdelim = nl
finish
c_journal = get setting("Recall",3,jkeys,jvalues,"TEMPRECALL")
c_nobl = get setting("(No)Blanks",2,lkeys,lvalues,"BLANKLINES")
c_dataecho = get setting("Echo",3,ekeys,evalues,"PARTECHO")
!
c_fstartfile = getstr("Fstartfile",31,"")
c_bstartfile = getstr("Bstartfile",31,"")
c_preloadfile = getstr("Preloadfile",31,"")
c_moddir = getstr("Activedir",31,defaultactivedir)
c_cfaults = getstr("Cfaults",31,".OUT")
c_cfaults = "" if c_cfaults = ".NULL"
c_cprompt = getstr("Cprompt",31,"Command:")
c_dprompt = getstr("Dprompt",31,"Data:")
!
for i = 1,1,16 cycle
prompt("Searchdir ".itos(i).": ")
ask:
readline(s)
uctranslate(addr(s)+1,length(s))
if s = "" or s = ".END" then start
c_searchdircount = i - 1
exit
finish
if length(s) > 31 then start
printstring("Reply must not exceed 31 characters".snl)
-> ask
finish
c_searchdir(i) = s
repeat
!
disconnect(file,flag)
printstring("Finished".snl)
set return code(0)
stop
!
err:
fail("MAKEOPTIONFILE",flag)
end ; ! of makeoptionfile
!
!
!***********************************************************************
!*
!* C H E C K P D
!*
!***********************************************************************
!
!<Checking partitioned files
!
! Partitioned files greater than 256 Kbytes in size present special
! problems if they contain members which are object files. An object
! file that crosses a 256 Kbyte boundary may not execute correctly, so
! the action of the subsystem loader is to make a copy of such a member,
! and execute that. This is clearly inefficient. The CHECKPD command
! provides facilities for identifying such problem members. It also
! flags other conditions which cause the loader to make a copy of an
! object file.
!
! The command takes exactly one parameter, the meaning of which is given
! in the following subsections.
!
!<Finding the offsets of members
!
! If CHECKPD is given the name of a partitioned file, it simply lists
! the relative offset (in hexadecimal) of each member of that file.
!>
!<Checking for possible problems
!
! If CHECKPD is given the name of a single member of a partitioned file,
! it determines whether either of two conditions would force the
! subsystem to copy the file when attempting to load it. These
! conditions are:
!
! a) The code of the member crosses a 256 Kbyte boundary
!
! b) The code of the member is not shareable (possible for converted ICL
! object files)
!>
!>
!
externalroutine checkpd(string (255) parms)
integer flag,conad,i
string (11) member
string (31) pdfile,file
record (rf) rr
record (hf)name or
record (pdf)name pd
record (hf)name pr
record (ofmf)arrayname ofm
record (pdf)arrayname pda
!
set return code(1000)
setpar(parms)
if parmap # 1 then start
flag = 263; ! Wrong number of parameters
-> err
finish
file <- spar(1)
!
connect(file,1,0,0,rr,flag)
-> err if flag # 0
!
if file -> pdfile.("_").member then start
connect(file,1,0,0,rr,flag)
-> err if flag # 0
conad = rr_conad
or == record(conad)
if or_filetype # ssobjfiletype then start
printstring("Member ".member." is not an object file".snl)
-> ok
finish
ofm == array(conad+or_ofm+4,ofmaf); ! Object file map
if (conad+ofm(1)_start) >> 18 # c
(conad+ofm(1)_start+ofm(1)_len) >> 18 then start
printstring("Code of member ".member.c
" crosses a 256 Kbyte boundary".snl)
-> ok
finish
if ofm(1)_props & 1 # 0 then start
printstring("Code of member ".member." is not shareable".snl)
-> ok
finish
printstring("No problems with member ".member.snl)
-> ok
else
conad = rr_conad
pr == record(conad)
pda == array(conad+pr_adir,pdaf)
i = 1
while i <= pr_count cycle
pd == pda(i)
printstring(pd_name)
spaces(15-outpos)
printstring("X".htos(pd_start,6).snl)
i = i + 1
repeat
finish
!
ok:
set return code(0)
stop
!
err:
fail("CHECKPD",flag)
end ; ! of checkpd
endoffile