subroutine RatSub(Caller, Name)
* RAT - Resource Analysis Tool subroutine.
LastUpdated... = "Rev: 14:56 06Jun1997 andrewm1 31 /home/andrew/BP/RAT.SUB"
* RAT - Resource Allocation Tool
* Recursive subroutine to analyze the resources used by a pick/basic
* program. This code will track down all file, subroutine, function and
* execute references as well as any I/O commands including all READs,
* WRITEs and CLEAR.FILEs.
*
***

$INCLUDE UPCASE.EQUATES

$include RATCOM
$include FDEF RAT.PROGS.FDEF
$include FDEF RAT.FILES.FDEF

VerbRead = convert("~",@FM,"READ~READU~READVU~MATREAD~MATREADU~READV")
VerbWrite = convert("~",@FM,"WRITE~WRITEU~WRITEVU~MATWRITE~MATWRITEU~WRITEV")
VerbDelete = convert("~",@FM,"DELETE~DELETEU")

locate Name in IgnoreProgs<1> setting Idx then
   crt "d":
   return
end else
   ins Name before IgnoreProgs<Idx>
end

Level += 1
crt "+":Level:
gosub Prepare
Level -= 1
crt "-":Level:
return

Prepare:
gosub ProcessCaller
gosub OpenFile
read Record from File(FileIdx), RecordName else
   return
end

***
* The following peculiar code is designed to circumvent a bug in
* Info/Basic where upcase() (and other functions) are not able to
* deal with strings in excess of 32KB. Code should be completely
* portable.
*
Source = Record
Record = ""
loop while len(Source) gt 0 do
   Record := convert(";",@FM,trim(upcase(Source[1,32767])))
   Source = Source[32768,len(Source)]
repeat

gosub ProcessOpen
gosub ProcessRead
gosub ProcessWrite
gosub ProcessDelete
gosub ProcessExecute
gosub ProcessDeffun
gosub ProcessFunction
gosub ProcessSubroutine
return

ProcessCaller:
if not(Caller) then return
read RatProgsRec from RatProgsFile, Name else
   RatProgsRec = ""
end
locate Caller in RatProgsRec<RATP$CALLIN,1> by "AL" setting Idx else
   ins Caller before RatProgsRec<RATP$CALLIN,Idx>
end
write RatProgsRec to RatProgsFile, Name

read RatProgsRec from RatProgsFile, Caller else
   RatProgsRec = ""
end
locate Name in RatProgsRec<RATP$CALLOUT,1> by "AL" setting Idx else
   ins Name before RatProgsRec<RATP$CALLOUT,Idx>
end
write RatProgsRec to RatProgsFile, Caller
return

ProcessOpen:
Target = "OPEN"
Occ = 0
loop
   Occ += 1
   Idx = index(Record,Target,Occ)
   if not(Idx) then return
   Line = Record<dcount(Record[1,Idx],@FM)>
   if Line[1,1] eq "*" then continue    ;* Skip the comments
   convert " " to @FM in Line
   if Line<1> matches "1N0N":@VM:"1N0N':'" then del Line<1>
   Idx = index(Line,Target,1)
   TokenIdx = dcount(Line[1,Idx],@FM)
   Token = Line<TokenIdx>
   if Token ne "OPEN" then continue
   FileVar = ""
   if Line<TokenIdx+2> eq "TO" then
      FileVar = Line<TokenIdx+3>
      FileName = field(Line<TokenIdx+2>,",",2)
      if FileName[1,1] eq '"' then FileName = FileName[2,len(FileName)-2]
   end else
      if Line<TokenIdx+3> eq "TO" then
         FileVar = Line<TokenIdx+4>
         FileName = Line<TokenIdx+3>
         if FileName[1,1] eq '"' then FileName = FileName[2,len(FileName)-2]
      end
   end
   if not(FileVar) then continue
   locate FileVar in OpenFileVars<1> by "AL" setting Idx else
      ins FileVar before OpenFileVars<Idx>
      ins FileName before OpenFileNames<Idx>
   end
   crt "O":
repeat
return

ProcessRead:
Occ = 0
Target = "READ"
loop
   Occ += 1
   Idx = index(Record,Target,Occ)
   if not(Idx) then return
   Line = Record<dcount(Record[1,Idx],@FM)>
   if Line[1,1] eq "*" then continue    ;* Skip the comments
   convert " " to @FM in Line
   if Line<1> matches "1N0N":@VM:"1N0N':'" then del Line<1>
   Idx = index(Line,Target,1)
   TokenIdx = dcount(Line[1,Idx],@FM)
   Token = Line<TokenIdx>
   if (TokenIdx ne 1) or not(Line<TokenIdx-1> match "THEN":@VM:"ELSE") then
      continue
   end
   locate Token in VerbRead<1> setting VerbIdx else continue
   if not(Line<TokenIdx+2> eq "FROM") then continue
   FileVar = field(Line<TokenIdx+3>,",",1)
   if not(alpha(FileVar[1,1])) then continue
   Access = VerbRead<VerbIdx>
   gosub UpdateRat
   crt "R":
repeat
return

ProcessWrite:
Target = "WRITE"
Occ = 0
loop
   Occ += 1
   Idx = index(Record,Target,Occ)
   if not(Idx) then return
   Line = Record<dcount(Record[1,Idx],@FM)>
   if Line[1,1] eq "*" then continue
   convert " " to @FM in Line
   Idx = index(Line,Target,1)
   TokenIdx = dcount(Line[1,Idx],@FM)
   Token = Line<TokenIdx>
   locate Token in VerbWrite<1> setting VerbIdx else continue
   if not(Line<TokenIdx+2> matches "ON":@VM:"TO") then continue
   FileVar = field(Line<TokenIdx+3>,",",1)
   Access = VerbWrite<VerbIdx>
   gosub UpdateRat
   crt "W":
repeat
return

ProcessDeffun:
Target = "DEFFUN"
FunctionList = ""
Occ = 0
loop
   Occ += 1
   Idx = index(Record,Target,Occ)
   if not(Idx) then return              ;* no more DEFFUN's
   Line = Record<dcount(Record[1,Idx],@FM)>
   if Line[1,1] eq "*" then continue    ;* no comments, thank you
   convert " " to @FM in Line
   Idx = index(Line,Target,1)
   TokenIdx = dcount(Line[1,Idx],@FM)
   Token = Line<TokenIdx>
   if Token ne "DEFFUN" then continue   ;* must be a word with DEFFUN in it
   Function = field(Line<TokenIdx+1>,"(",1)
   locate Function in FunctionList<1> by "AL" setting Idx else
      ins Function before FunctionList<Idx>
   end
   crt "f":
repeat
return

ProcessDelete:
Target = "DELETE"
Occ = 0
loop
   Occ += 1
   Idx = index(Record,Target,Occ)
   if not(Idx) then return
   Line = Record<dcount(Record[1,Idx],@FM)>
   if Line[1,1] eq "*" then continue
   convert " " to @FM in Line
   Idx = index(Line,Target,1)
   TokenIdx = dcount(Line[1,Idx],@FM)
   Token = Line<TokenIdx>
   locate Token in VerbDelete<1> setting VerbIdx else continue
   FileVar = field(Line<TokenIdx+1>,",",1)
   Access = VerbDelete<VerbIdx>
   gosub UpdateRat
   crt "D":
repeat
return

ProcessExecute:
Target = "EXECUTE"
Occ = 0
loop
   Occ += 1
   Idx = index(Record,Target,Occ)
   if not(Idx) then return
   Line = Record<dcount(Record[1,Idx],@FM)>
   if Line[1,1] eq "*" then continue
   convert " " to @FM in Line
   Idx = index(Line,Target,1)
   TokenIdx = dcount(Line[1,Idx],@FM)
   Token = Line<TokenIdx>
   if Token ne Target then continue
   Verb = Line<TokenIdx+1>
   if not(Verb[1,1] matches "'":@VM:'"') then continue
   Verb = Verb[2,len(Verb)]
   read RatProgsRec from RatProgsFile, Name else
      RatProgsRec = ""
   end
   Access = Target:"*":Verb
   locate Access in RatProgsRec<RATP$CALLOUT,1> by "AL" setting Idx else
      ins Access before RatProgsRec<RATP$CALLOUT,Idx>
   end
   write RatProgsRec to RatProgsFile, Name
   crt "E":
repeat
return

ProcessFunction:
MoreFunctions = len(FunctionList) gt 0
loop while MoreFunctions do
   remove Target from FunctionList setting MoreFunctions
   Occ = 0
   loop
      Occ += 1
      Idx = index(Record,Target,Occ)
      if not(Idx) then exit
      Line = Record<dcount(Record[1,Idx],@FM)>
      if Line[1,1] eq "*" then continue
      convert " " to @FM in Line
      Idx = index(Line,Target,1)
      TokenIdx = dcount(Line[1,Idx],@FM)
      Token = Line<TokenIdx>
      if Token ne Target then exit
      crt "F":
      call @RatSub(Name,field(Name,"*",1):"*":Target)
   repeat
repeat
return

ProcessSubroutine:
Target = "CALL"
Occ = 0
loop
   Occ += 1
   Idx = index(Record,Target,Occ)
   if not(Idx) then return
   Line = Record<dcount(Record[1,Idx],@FM)>
   if Line[1,1] eq "*" then continue
   convert " " to @FM in Line
   Idx = index(Line,Target,1)
   TokenIdx = dcount(Line[1,Idx],@FM)
   Token = Line<TokenIdx>
   if Token ne "CALL" then return       ;* only real calls
   if (index(Line<TokenIdx+1>,"(",1) eq 0) and (Line<TokenIdx+2>[1,1] ne "(") then continue
   Try = field(Line<TokenIdx+1>,"(",1)
   if not(alpha(Try[1,1])) then Try = Try[2,len(Try)]
   if not(Try) then continue
   crt "C":
   call @RatSub(Name, field(Name,"*",1):"*":Try)
repeat
return

UpdateRat:
locate FileVar in OpenFileVars<1> setting Idx then
   FileName = OpenFileNames<Idx>
end else
   FileName = FileVar
end

read RatProgsRec from RatProgsFile, Name else
   RatProgsRec = ""
end
locate FileName in RatProgsRec<RATP$FILE,1> by "AL" setting Idx else
   ins FileName before RatProgsRec<RATP$FILE,Idx>
   ins ""       before RatProgsRec<RATP$ACTION,Idx>
end
locate Access in RatProgsRec<RATP$ACTION,Idx,1> by "AL" setting SVM else
   ins Access before RatProgsRec<RATP$ACTION,Idx,SVM>
end
RatProgsRec<RATP$STAMP> = date():"*":time()
write RatProgsRec to RatProgsFile, Name

read RatFilesRec from RatFilesFile, FileVar else
   RatFilesRec = ""
end
locate Name in RatFilesRec<RATF$BP,1> by "AL" setting Idx else
   ins Name before RatFilesRec<RATF$BP,Idx>
   ins ""   before RatFilesRec<RATF$ACTION,Idx>
end
locate Access in RatFilesRec<RATF$ACTION,Idx,1> by "AL" setting SVM else
   ins Access before RatFilesRec<RATF$ACTION,Idx,SVM>
end
RatFilesRec<RATF$STAMP> = date():"*":time()
write RatFilesRec to RatFilesFile, FileVar
return

OpenFile:
FileName = field(Name,"*",1)
RecordName = field(Name,"*",2)
locate FileName in FileNames<1> setting FileIdx then
   FileName = FileNames<FileIdx>
end else
   FileIdx = dcount(FileNames,@FM) + 1
   open FileName to File(FileIdx) else
      crt
      crt "Unable to open ":FileName:" file.  (ratsub)"
      FileIdx = 0
      return
   end
   FileNames<FileIdx> = FileName
end
return

end