%constant %integer ssobjfiletype= 1
%constant %integer ssdirfiletype= 2
%constant %integer sscharfiletype= 3
%constant %integer ssdatafiletype= 4
%constant %integer sscorruptobjfiletype=5
%constant %integer sspdfiletype= 6
%constant %integer ssoptfiletype= 9
%constant %integer usingworkfile=0
%record %format connect report format(%integer connect address, file type,
    data start, data end)
%record %format contf(%integer dataend, datastart, psize, filetype, sum,
    datetime, spare1, spare2, mark, null1, ugla, astk, ustk, null2, itwidth,
    ldelim, rdelim, journal, searchdircount, arraydiag, initworksize, spare,
    itinsize, itoutsize, nobl, istk, %long %integer initparms,
    %integer dataecho, terminal, i23, i24, i25, i26, i27, i28, i29, i30, i31,
    i32, %string (31) fstartfile, bstartfile, preloadfile, moddir, cfaults,
    s6, s7, 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))
%record %format arf(%string (31) name, %integer type)
%system %routine %spec setpar(%string (255) s)
%system %string (255) %function %spec spar(%integer ep)
%system %routine %spec ssmessa(%integer fail, %string (63) fname)
%system %routine %spec disconnect(%string (31) file, %integer %name flag)
%system %routine %spec connect(%string (31) file, %integer mode, hole,
    protection, %record (connect report format) %name report,
    %integer %name flag)
%system %routine %spec fileanal(%string (31) file,
    %record (arf) %array %name r, %integer %name count, flag)
%external %routine %spec clear(%string (255) s)
%external %routine %spec define(%string (255) s)
%external %integer %function %spec exist(%string (31) file)
%routine %spec anal(%string (31) file)
%own %integer full= 0, filing=0, conmode=0
%own %record (connect report format) r

%integer %function check error(%integer flag, %string (63) fmess)
   %result = 0 %if flag = 0
   ssmessa(flag, fmess)
   newline
   %result = flag
%end

%routine history(%string (255) file)
   %routine note(%string (31) file)
      selectoutput(0)
      printstring(file)
      newline
      selectoutput(2)
   %end

   %routine check for source(%string (255) files)
      %string (255) others, file, owner1, owner2
      others = files
      others -> owner1.(".").files
      %while others # "" %cycle
         %unless others -  > file.("+").others %start
            file = others
            others = ""
         %finish
         %if file -  > owner2.(".").file %then file = owner2.".".file %else %c
            file = owner1.".".file
         length(file) = 31 %if length(file) > 31
         %if exist(file) # 0 %start
            %if filing = 1 %then note(file)
            printstring("*** ".file." exists")
         %finish %else printstring("    ".file." does not exist")
         newline
         disconnect(file, flag)
      %repeat
   %end;                                 !of check for source

   %record (connect report  format) rr
   %integer flag, lda, p, conad
   %string (255) source, source1, source2
   connect(file, conmode, 0, 0, rr, flag)
   %return %if 0 # check error(flag, file)
   conad = rr_connect address
   lda = conad + integer(conad + 24);    !start of load data
   p = conad + integer(lda + 48);        !start of object data
   %while byteinteger(p) # 0 %cycle
      %if byteinteger(p) = 1 {source file type} %start
         source = string(p + 1)
         %if source -  > source1.("+").source2 %start
            source = source1."+".source2
            printstring("    (Source file(s):".source.")")
            newline
         %finish
         check for source(source)
      %finish
      p = p + byteinteger(p + 1) + 2;    !point to next item
   %repeat
   newline
%end

%routine print file size
   %integer %function file length(%record (connect report format) %name r)
      %result = r_data end - r_data start
   %end
   printstring("( ")
   write(file length(r), 1)
   printstring(" Bytes)")
%end


%routine objanal(%string (31) file)
   %constant %byte %integer %array headoffset(16:20)=  4,16,28,32,36
   %constant %byte %integer %array idenoffset(16:20)=  8,16,8,8,12
   %constant %string (255) %array list name(16:20)= %c
      "    Procedure Entries:" ,
      "    Data Entries:"    ,
      "    Procedure References:",
      "    Dynamic Procedure References:"    ,
      "    Data References:"
   %record (connect report format) rr
   %integer lda, list, link, conad, flag, i, newl, lists
   connect(file, conmode, 0, 0, rr, flag)
   %return %if 0 # check error(flag, file)
   conad = rr_connect address
   newl = 0
   printstring("Object: ".file."     ")
   print file size
   newline
   lda = conad + integer(conad + 24);    !abs addr ldata
   %if full = 1 %then lists = 20 %else lists = 16
   %cycle list = 16, 1, lists
      i = 0
      link = integer(lda + headoffset(list)); !head of right list
      %while link # 0 %cycle
         newl = 0
         %if i = 0 %then printstring(list name(list).":".tostring(nl))
         printstring("    ")
         printstring(string(conad + link + idenoffset(list)))
         i = i + 1
         %if i = 5 %then i = 1 %and newline %and newl = 1
         link = integer(conad + link)
      %repeat
      %if newl # 1 %and i > 0 %then newline
   %repeat
   history(file)
   disconnect(file, flag)
%end

%routine pdanal(%string (31) file)
   %record (arf) %array r(1:500)
   %integer flag, count, i
   printstring("PD file: ".file."     ")
   print file size
   newline
   count = 500
   fileanal(file, r, count, flag)
   %return %if 0 # check error(flag, file)
   %for i = 1, 1, count %cycle
      anal(file."_".r(i)_name) %if r(i)_type = 19
   %repeat
   disconnect(file, flag)
%end

%routine charanal(%string (31) file)
   %integer flag
   printstring("Character file: ".file."     ")
   print file size
   newline
   disconnect(file, flag)
%end

%routine datanal(%string (31) file)
   %integer flag
   printstring("Data File: ".file."     ")
   print file size
   newline
   disconnect(file, flag)
%end

%routine diranal(%string (31) file)
   %record (arf) %array r(1:500)
   %integer flag, count, i
   printstring("Directory: ".file)
   newline
   count = 500
   fileanal(file, r, count, flag)
   %return %if 0 # check error(flag, file)
   %for i = 1, 1, count %cycle
      anal(r(i)_name) %if r(i)_type = 1
   %repeat
   disconnect(file, flag)
%end

%routine optanal(%string (31) file)
   %record (contf) %name opt
   %record (connect report format) r
   %string (6) user
   %integer i, flag
   %if file -  > user.(".").file %then file = user.".".file %else user = ""
   connect(file, conmode, 0, 0, r, flag)
   %return %if 0 # check error(flag, file)
   opt == record(r_connect address)
   printstring("Options file: ".file)
   newline
   printstring("              Accessing the following directories:")
   newline
   printstring("              ")
   %if user # "" %then printstring(user.".".opt_moddir) %else %c
      printstring(opt_moddir)
   printstring("  (active directory)")
   newline
   %for i = 1, 1, opt_searchdircount %cycle
      printstring("              ".opt_searchdir(i))
      newline
   %repeat
   %if user # "" %then anal(user.".".opt_moddir) %else anal(opt_moddir)
   %for i = 1, 1, opt_searchdircount %cycle
      anal(opt_searchdir(i))
   %repeat
   disconnect(file, flag)
%end

%routine anal(%string (31) file)
   %integer flag
   connect(file, conmode, 0, 0, r, flag)
   %return %if 0 # check error(flag, file)
   %if r_filetype = ssobjfiletype %then objanal(file)
   %if r_filetype = sspdfiletype %then pdanal(file)
   %if r_filetype = ssdirfiletype %then diranal(file)
   %if r_filetype = ssoptfiletype %then optanal(file)
   %if r_filetype = sscharfiletype %then charanal(file)
   %if r_filetype = ssdatafiletype %then datanal(file)
%end

%external %routine all sources(%string (255) s)
   %string (31) file
   setpar(s)
   file = spar(1)
   %if spar(2) = "*" %then full = 1 %else full = 0
   %if spar(3) # "" %then %start
      filing = 1
      define("2,".spar(3))
      selectoutput(2)
   %finish %else filing = 0
   file = "SS#OPT" %if file = ""
   anal(file)
   %if filing # 0 %start
      selectoutput(0)
      closestream(2)
      clear("2")
   %finish
%end

%external %routine ss all sources(%string (255) s)
   %string (31) file
   setpar(s)
   file = spar(1)
   conmode = 9
   %if spar(2) = "*" %then full = 1 %else full = 0
   %if spar(3) # "" %then %start
      filing = 1
      define("2,".spar(3))
      selectoutput(2)
   %finish %else filing = 0
   file = "SS#OPT" %if file = ""
   anal(file)
   %if filing # 0 %start
      selectoutput(0)
      closestream(2)
      clear("2")
   %finish
%end

%end %of %file