%constant %integer ssdatafiletype= 4
%constant %integer ssobjfiletype= 1
%constant %integer sscorruptobjfiletype=5
%constant %integer ssdirfiletype= 2
%constant %integer sscharfiletype= 3
%constant %integer sspdfiletype= 6
%constant %integer ssoptfiletype= 9
%record %format arf(%string (31) name, %integer type)
%record %format pdhf(%integer dataend, datastart, size, filetype, sum,
       datetime, adir, count)
%record %format rf(%integer conad, filetype, datastart, dataend)
%record %format dhf(%integer dataend, datastart, size, filetype, sum,
       datetime, pstart, spare)
%record %format lnf(%byte %integer type, %string (6) name, %integer rest,
       point, dr1)
%record %format frf(%integer conad, filetype, datastart, datend, size, rup,
       eep, mode, users, arch, %string (6) tran, %string (8) date, time,
       %integer count, spare1, spare2)
%record %format hf(%integer dataend, datastart, filesize, filetype, sum,
       datetime, format, records)
%record %format dahf(%integer dataend, datastart, size, filetype, date, time,
       format, records)
%system %routine %spec setwork(%integer %name ad, flag)
%external %string %function %spec fromstring(%string %name s, %integer i, j)
%system %routine %spec connect(%string (31) file, %integer mode, hole, prot,
       %record (rf) %name r, %integer %name flag)
%system %routine fileanal(%string (31) file, %record (arf) %array %name r,
       %integer %name count, flag)
   %integer pstart, hashconst, i, conad, point, max, lda, list
   %integer link, mark
   %constant %byte %integer %array headoffset(16:20)= %c
   4,16,28,32,36
   %constant %byte %integer %array idenoffset(16:20)= %c
8,16,8,8,12
   %string (255) s
   %record (pdhf) %name pdh
   %record (dhf) %name dh
   %record (rf) rr
   %record (lnf) %array %format haf(0:10000)
   %record (lnf) %array %name h
      max = count; !max no of elements in array r
      count = 0; !number filled by analyse
      connect(file, 0, 0, 0, rr, flag)
      ->err %if flag # 0
      conad = rr_conad
      %if rr_filetype = ssobjfiletype %start; !object file
         lda = conad + integer(conad + 24); !abs addr ldata
         %cycle list = 16, 1, 20
            link = integer(lda + headoffset(list)); !head of right list
            %while link # 0 %cycle
               count = count + 1
               ->full %if count > max
               r(count)_name = string(conad + link + idenoffset(list))
               r(count)_type = list
               link = integer(conad + link)
            %repeat
         %repeat
         ->err
      %finish
      %if rr_filetype = ssdirfiletype %start; !directory file
         dh == record(conad); !directory header
         hashconst = integer(conad + dh_datastart); !no of items in hash table
         h == array(conad + dh_datastart + 4, haf); !map onto hash arrray
         pstart = conad + dh_pstart
         point = 4; !first string
         !cycle through plist
         %while byteinteger(point + pstart) # 0 %cycle
            s = string(point + pstart)
            %if '=' # charno(s, 1) # 255 %and length(s) > 7 %and %c
                  charno(s, 7) = '.' %then %start
               ! not an alias or empty string
               count = count + 1
               ->full %if count > max; !array r is full
               r(count)_name = s
               r(count)_type = ssobjfiletype
               !now look for entry names that point to this name
               %cycle mark = 0, 1, 1; ! 0 for procedure entries, 1 for data entries.
                  %cycle i = 0, 1, hashconst - 1
                     %if h(i)_point = point %and h(i)_name # ".EMPTY" %and %c
                           h(i)_name # "" %and h(i)_type & 1 = mark %then %c
                           %start
                        count = count + 1
                        ->full %if count > max
                        %if h(i)_type & X'80' # 0 %then %c
                              r(count)_name = h(i)_name.string %c
                              (conad + dh_pstart + h(i)_rest) %else %c
                              r(count)_name = h(i)_name
                        r(count)_type = mark + 16; ! 16 for procedure, 17 for data.
                     %finish
                  %repeat
               %repeat
            %finish
            point = point + length(s) + 1; !move on to next string in plist
         %repeat
         !now look for aliases
         point = 4; !first string in pointer list
         %while byteinteger(point + pstart) # 0 %cycle
            s = string(point + pstart)
            %if charno(s, 1) = '=' %start
               count = count + 1
               ->full %if count > max
               r(count)_name = fromstring(s, 2, length(s))
               !remove '='
               r(count)_type = 21; !aliased name
               !now look for aliases that point here.
               %cycle i = 0, 1, hashconst - 1
                  %if h(i)_point = point %and h(i)_name # ".EMPTY" %and %c
                        h(i)_name # "" %then %start
                     count = count + 1
                     ->full %if count > max
                     %if h(i)_type & X'80' # 0 %then %c
                           r(count)_name = h(i)_name.string %c
                           (conad + dh_pstart + h(i)_rest) %else %c
                           r(count)_name = h(i)_name
                     r(count)_type = 16
                  %finish
               %repeat
            %finish
            point = point + length(s) + 1; !move on to next string in plist
         %repeat
         ->err
      %finish; !end of directory file
      %if rr_filetype = sspdfiletype %start; !partitioned file
         pdh == record(conad)
         %if pdh_count <= max %then count = pdh_count %else %start
            flag = 300
            count = max
         %finish
         !check if enough room in array r
         ->err %if count = 0; !no members
         point = conad + pdh_adir + 4
         %cycle i = 1, 1, count
            r(i)_name = string(point + (i - 1) * 32)
            r(i)_type = 19; !member of a pdfile
         %repeat
         ->err
      %finish
full:

      flag = 300; !user did not provide enough room in r
      count = count - 1; !reset count
err:

%end; !of fileanal

%external %routine testanal(%string (255) file)
   %integer i, flag, count, ad
   %constant %integer maxrecs=10000
   %record (arf) %array %format arfaf(1:maxrecs)
   %record (arf) %array %name r
      ad = maxrecs * (32 + 8)
      setwork(ad, flag)
      r == array(ad, arfaf)
      count = maxrecs
      flag = 0
      fileanal(file, r, count, flag)
      write(flag, 1); newline
      %for i = 1, 1, count %cycle
         %exit %if r(i)_name = ""
         printstring(r(i)_name."  is of type ")
         write(r(i)_type, 1)
         newline
      %repeat
%end
%end %of %file