

Source of S#PD LIST


%CONST %INTEGER    SS pd file type      = 6
%CONST %INTEGER    SS opt file type     = 9


( S# pd list

%SYSTEM %ROUTINE pd list(%INTEGER start address, types wanted)

    Prints the names of the members of the partitioned file
 connected at address 'start address' and their sub-members in turn.
    Prints out the file-type for each member if 'types wanted' # 0
)

%ROUTINE lower case(%STRING(255) Text)
%INTEGER each
   %IF LENGTH(Text)>1 %START
      %CYCLE each = 2,1,LENGTH(Text)
         CHARNO(Text,each) = CHARNO(Text,each)!!32 %C
            %IF 'A'<=CHARNO(Text,each)<='Z'
      %REPEAT
   %FINISH
   PRINTSTRING(Text)
%END


%RECORD %FORMAT header fm(%INTEGER relative finish, %C
                                   relative start, %C
                                   size, %C
                                   type, %C
                                   sum, date time, %C
                                   directory start, %C
                                   count)

%RECORD %FORMAT entry fm(%INTEGER relative start, %C
                         %STRING (11) name, %C
                         %INTEGER hole, %C
                         %INTEGER Spare5,Spare6,link)

%INTEGER nesting depth, print control

%ROUTINE local pdl(%INTEGER  start address, %C
                             nesting depth, %C
                             types wanted, %C
                   %INTEGER %NAME print control)


%ROUTINE %SPEC  insert link(%INTEGER index, %C
                       %INTEGER %NAME link)

   %RECORD (entry fm) %ARRAY %FORMAT pdfile directory(1:256)
   %RECORD (entry fm) %ARRAY %NAME   entry

   %RECORD (header fm) %NAME          pd file
   %RECORD (header fm) %NAME          pd member

   %STRING (11) member name
   %INTEGER %ARRAY copy(1:256)
   %INTEGER i,m,index,n,indentation,type

   %CONST %INTEGER Known types = 6

   %CONST %INTEGER Max Filename = 11
   %CONST %INTEGER Tidy Gap = 4

   %CONST %INTEGER %ARRAY text(0:Known types) = %C
      M'N-S',
      M'Obj',
      M'Dir',
      M'Char',
      M'Data',
      M'Fobj',
      M'PD'

   index = 0
   indentation = (Max Filename+Tidy Gap)*(nesting depth-1)
   pd file == RECORD(start address)
   entry == ARRAY(start address+pd file_directory start,pdfile directory)

   %CYCLE i=1,1,pd file_count
      insert link(i,index)
   %REPEAT

   %CYCLE

      SPACES(indentation) %IF print control=1
      %RETURN %IF index=0

      member name = entry(index)_name
      pd member == RECORD(start address+entry(index)_relative start)

      lower case(member name)
      SPACES(Tidy Gap+Max Filename-LENGTH(member name))

      %IF pd member_type=SS pd file type %C
          %AND pd member_count#0 %START
         print control = 0
         local pdl(entry(index)_relative start+start address, %C
                   nesting depth+1,types wanted,print control)
      %FINISH %ELSE %START

         %IF types wanted#0 %START
            %IF 0<=pd member_type<=Known types %C
               %THEN type = text(pd member_type) %ELSE %START
            %IF pd member_type=SS opt file type %C
               %THEN type = M'Opt' %C
               %ELSE type = M'Bad!'
            %FINISH

            PRINTSYMBOL('(')
            %CYCLE i = 24,-8,0
               PRINTSYMBOL(type>>i&127)
            %REPEAT
            PRINTSYMBOL(')')
         %FINISH

      %FINISH

      print control = 1 %AND %RETURN %IF copy(index)=0

      NEWLINE

      SPACES(indentation)
      print control = 0


      index = copy(index)

   %REPEAT

%ROUTINE insert link(%INTEGER i, %INTEGER %NAME list)
%INTEGER link,oldlink

   %IF list=0 %START
      copy(i) = 0
      list = i
      %RETURN
   %FINISH

   link = list

   %CYCLE

      %IF entry(i)_name<entry(link)_name %START
         copy(i) = link
         %IF list=link %THEN list = i %ELSE copy(oldlink) = i
         %RETURN
      %FINISH

      oldlink = link
      link = copy(link)

      %IF link=0 %START
         copy(i) = 0
         copy(oldlink) = i
         %RETURN
      %FINISH

   %REPEAT

%END;! of insert

%END;! of local pdl

nesting depth = 1 ; print control = 0
local pdl(start address, nesting depth, types wanted, print control)

%END;! of system routine pd list

%END %OF %FILE