%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 prof(%string(11) key,
                              %integer dr0, address,
                              %integername version, uflag,%string(6) user)

   ! (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(user.".SS#PROFILE")=no

   ! Now set up no of tries at connection, and delay time.
maxtries=3

   %for i = 1,1,maxtries %cycle
      connect(user.".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(user.".SS#PROFILE", flag)
%end; ! of %external %routine read profile.
%endoffile