record format profile f(string (11) key, integer version, offset, length)
record format ssprofile f(integer end, start, size, filetype, checksum,
datetime, format, sp0, marker, max profiles,
no profiles, sp1, record (profile f)array c
profile(1:500)); ! 500 will never be approached.
! Structure of profile file: It starts with the format of ssprofile f
! above. The first 8 words are standard Subsystem header. Thereafter:
! marker: to check against overwriting or other corruption.
! max profiles: the maximum number of profiles which this file can currently hold.
! no profiles: the actual number of profiles held.
! profile: a record array (1:max profiles), each element containing the
! following:
! key: the keyword (the only access to profile data)
! version: the version number of the profile format.
! offset: the offset of the start of the profile data.
! length: the length of the profile data, as seen by the
! user. The profile scheme adds a marker word
! and rounds up to word align the data.
! All the above is treated as file header, and the second word of the header
! is set accordingly. The 'data' part of the file is thus the profile data,
! pointed at from the profile array (described above). The format of the
! profile data is determined by the using program. The scheme merely adds
! a marker word to check against corruption.
constant integer marker = x'84848484'
constant integer no = 0, yes = 1
constant integer read and write = 3, read shared = 9
constant integer data file = 4, unstructured = 3
recordformat rf(integer conad, filetype, data start, data end)
externalintegerfnspec exist(string (31) file)
externalroutinespec cherish(string (31) file)
externalroutinespec ddelay(integer seconds)
externalintegerfnspec uinfi(integer entry)
systemroutinespec outfile(string (31) file, integer length, maxbytes,
protection, integername conad, flag)
systemroutinespec connect(string (31) file, integer access, maxbytes,
protection, record (rf)name r, integername flag)
systemroutinespec disconnect(string (31) file, integername flag)
systemroutinespec move(integer length, from, to)
systemroutinespec newgen(string (31) updated file, original file, integername flag)
!------------------------------------------
externalroutine read profile(string (11) key,
integer dr0, address,
integername version, uflag)
! (dr0, address) is the descriptor of the %name-type variable passed.
integer conad, flag, profad, i, length, ulength, maxtries, secs
record (ssprofile f)name ssprofile
record (rf) r
record (profile f)name p
if dr0&x'02000000'#0 start ; ! unscaled - record or string.
ulength = dr0&x'00FFFFFF'; ! size of record or string passed.
finishelsestart
i = dr0>>27&7 - 3; i = 0 if i<0; ! size code
ulength = 2¬¬i*(dr0&x'00FFFFFF'); ! size in bytes
finish
! Now ulength gives the length of the variable passed.
version = 0; length = 0; uflag = 0
uflag = 7 and ->copy if key=""
uflag = 3 and ->copy if exist("SS#PROFILE")=no
! Now set up no of tries at connection, and delay time.
if uinfi(2) = 2 start ; ! Background.
maxtries = 5; secs = 20
finishelsestart ; ! Foreground.
maxtries = 3; secs = 1
finish
for i = 1,1,maxtries cycle
connect("SS#PROFILE", read shared, 0, 0, r, flag)
exit if flag=0; ! Success
ddelay(secs)
repeat
uflag = 5 and ->copy unless flag=0; ! Failed to connect.
! Now try to find key.
conad = r_conad
ssprofile == record(conad)
uflag = 6 and ->copy unless ssprofile_marker=marker; ! File corrupt.
i = 0
i = i+1 until i>ssprofile_noprofiles or key=ssprofile_profile(i)_key
uflag = 4 and -> copy if i>ssprofile_no profiles or c
ssprofile_profile(i)_version<0; ! Not found
p == ssprofile_profile(i)
uflag = 6 and ->copy if integer(conad+p_offset)#marker; ! File corrupt.
version = p_version
length = p_length
profad = conad+p_offset+4; ! 4 to step over marker word.
copy:
uflag = 1 and length = ulength if length>ulength; ! File data > info parameter.
move(length,profad,address) if length>0
byteinteger(i) = 0 for i=address+length,1,address+ulength-1
! Zero rest of user's variable, if necessary.
uflag = 2 if 0<length<ulength; ! Info parameter > file data.
disconnect("SS#PROFILE", flag)
end ; ! of %external %routine read profile.
!------------------------------------------
externalroutine write profile(string (11) key,
integer dr0, address,
integername version, uflag)
! (dr0, address) is the descriptor of the %name-type variable passed.
integer conad, flag, tconad, i, j, k, l, length, mode
record (rf) r
record (ssprofile f)name ssprofile, tprofile
record (profile f)name p
routine create profile file(string (31) file, integer size, max profiles,
integername flag)
integer conad
record (ssprofile f)name ssprofile
outfile(file, size, 0, 0, conad, flag)
return if flag#0; ! Failure.
cherish(file)
ssprofile == record(conad); ! ssprofile mapped onto file.
ssprofile_filetype = data file
ssprofile_format = unstructured
ssprofile_marker = marker
ssprofile_max profiles = max profiles
ssprofile_no profiles = 0
ssprofile_start = addr(ssprofile_profile(maxprofiles+1))-conad
ssprofile_end = ssprofile_start
! Thus the whole of record ssprofile is taken as the file header, and
! _start and _end refer to the profile data only.
end ; ! of %routine create profile file.
routine move profile(record (profile f)arrayname profile1, profile2,
integer index1, index2, conad1, conad2)
! This routine moves profile1(index1) to profile2(index2).
! conad1 and conad2 give connect addresses, and also "end of data" word.
! The routine does not update the "no profiles" word in the profile2 file.
integer l
l = (profile1(index1)_length+3)&x'FFFFFFFC' + 4
! Word aligned, 4 bytes for initial marker.
profile2(index2) = profile1(index1)
profile2(index2)_offset = integer(conad2)
integer(conad2) = integer(conad2) + l; ! Update end of data pointer.
move(l, conad1+profile1(index1)_offset, conad2+profile2(index2)_offset)
! Move profile data.
end ; ! of %routine move profile.
! Start of write profile code proper.
if version<0 start ; ! Means keyword is to be deleted.
length = 0
finish else if dr0&x'02000000'#0 start ; ! unscaled - record or string.
length = dr0&x'00FFFFFF'; ! size of record or string passed.
finishelsestart
i = dr0>>27&7 - 3; i = 0 if i<0; ! size code
length = 2¬¬i*(dr0&x'00FFFFFF'); ! size in bytes
finish
! Now length gives the length of the variable passed.
uflag = 0
uflag = 7 and return if key=""
uflag = 6 and return if length>4060
if exist("SS#PROFILE")=no start
uflag = 1
return if version<0
create profile file("SS#PROFILE", 4096, 16, flag)
! File of 1 epage structured for 16 profile entries.
uflag = 2 and return if flag#0
finish
cycle
! Try to connect file in read-and-write mode.
mode = read and write
for i=1,1,2 cycle
connect("SS#PROFILE", mode, 0, 0, r, flag)
exit if flag=0
ddelay(1); ! 1 second delay, once.
repeat
if flag#0 start
mode = read shared
connect("SS#PROFILE", mode, 0, 0, r, flag)
uflag = 3 and return if flag#0
finish
conad = r_conad
ssprofile == record(conad); ! record ssprofile mapped onto file SS#PROFILE.
exit unless mode=read shared or ssprofile_no profiles = c
ssprofile_max profiles or ssprofile_size<ssprofile_end+length+8
! SS#PROFILE full or connected in read shared. Create a temporary file then NEWGEN later.
uflag = 5 and return if ssprofile_max profiles+16>500; ! Most unlikely.
for j = 0,1,1 cycle
! Compaction when j=0.
! Expansion when j=1.
create profile file("T#NPROFILE", ssprofile_size+4096*j,
ssprofile_max profiles+16*j, flag)
! 1 more epage, 16 more profile entries when j=1.
uflag = 4 and return if flag#0
connect("T#NPROFILE", read and write, 0, 0, r, flag)
uflag = 4 and return if flag#0
! Now copy contents of SS#PROFILE into T#NPROFILE.
tconad = r_conad
tprofile == record(tconad); ! tprofile mapped onto T#NPROFILE.
k = 0
for i=1,1,ssprofile_no profiles cycle
continue if ssprofile_profile(i)_version<0; ! This entry has been deleted.
k = k+1
move profile(ssprofile_profile, tprofile_profile, i, k, conad, tconad)
repeat
tprofile_no profiles = k
exit if tprofile_no profiles<tprofile_max profiles and c
tprofile_size>tprofile_end+length+8
repeat
newgen("T#NPROFILE", "SS#PROFILE", flag)
uflag = 4 and return if flag#0
repeat
! We now know that SS#PROFILE is big enough, and connected in write mode.
! See if given key is in file.
i = 0
i = i+1 until i>ssprofile_no profiles or ssprofile_profile(i)_key=key
p == ssprofile_profile(i)
p_key = key
p_version = version
p_offset = integer(conad)
p_length = length
integer(conad+integer(conad)) = marker
move(length, address, conad+integer(conad)+4) if length>0
l = (length+3)&x'FFFFFFFC'+4
integer(conad) = integer(conad)+l; ! Update end pointer.
ssprofile_no profiles = i if i>ssprofile_no profiles
! Note: we do not attempt to recover old data space. It will be retrieved
! when (if) the whole file gets copied.
disconnect("SS#PROFILE", flag)
end ; ! of %external %routine write profile.
endoffile