htmlf.html


USE Tree;

CONST
  SkipIdents = {'QUERY', 'MAIN', 'QIDERR', 'ITEMERR',
                'SQLCA', 'SQLCODE', 'NOHANDLE', 'READABLE',
                'EIBTIME', 'EIBTRMID', 'EIBDATE', 'QUOTE', 'EIBAID',
                'LENGTH', 'LENGERR', 'EIBCALEN'};
VAR                
  UnknownIdents := {};                

PROCEDURE EnclosingBlock(x);
  BEGIN
  RESULT := x.Father;
  WHILE (RESULT <> VOID) AND NOT (RESULT IS StatementBlock) DO
    RESULT := RESULT.Father;
    END;
  END EnclosingBlock;  

PROCEDURE FindDataFields (a);
BEGIN
IF NOT (a IN SkipIdents) THEN
  RESULT := ROOT.DataDivision.WorkingStorageSection.Data.FindField (a);
  IF #RESULT = 0 THEN
    IF ROOT.DataDivision.LinkageSection <> VOID THEN
      RESULT := ROOT.DataDivision.LinkageSection.Data.FindField (a);
          END;
    END;
  END;
END FindDataFields;

PROCEDURE MarkCicsStatement (s);
VAR
  p;
BEGIN
p := s;
WHILE (p <> VOID) AND NOT (p IS ExecBlock) DO
  p := p.Father;
  END;
IF p <> VOID THEN
  PatchNt (p,  '<A NAME=ID' & s.Nr & '><FONT COLOR="RED">',
                '</FONT></A>');
  END;  
END MarkCicsStatement;

PROCEDURE MarkBlockUsage (Bl, Id);
BEGIN
ASSERT Bl IS StatementBlock;
ASSERT Id IS Ident;
IF Id <> Bl.LabelIdent THEN
  IF NOT (Bl CAN Usages) THEN
    Bl.Usages := {};
    END;
  Bl.Usages := Bl.Usages & {Id};  
  END;
END MarkBlockUsage;  

PROCEDURE MarkDataFieldUsage (Field, Id);
BEGIN
ASSERT Field IS DataField;
ASSERT Id IS Ident;
IF Id <> Field.Id THEN
  IF NOT (Field CAN Usages) THEN
    Field.Usages := {};
    END;
  ASSERT Field CAN Usages;  
  Field.Usages := Field.Usages & {Id};  
  END;
END MarkDataFieldUsage;  

PROCEDURE MarkLabel (Id);
VAR
  Bl;
BEGIN
Bl := ROOT.ProcedureDivision.FindBlock (Id.Image);
IF Bl = VOID THEN
  OUT.WriteLn ("Label not found: ", Id.Image);
 ELSE
  MarkBlockUsage (Bl, Id);
  END;
END MarkLabel;  

PROCEDURE MarkDataIdent (Id);
VAR
  a,
  Fields;
BEGIN
a := Id.Image;
Id.Ref := VOID;
IF NOT (a IN SkipIdents) THEN
  Fields := FindDataFields (a);
  IF #Fields = 0 THEN
    IF NOT (a IN UnknownIdents) THEN
      UnknownIdents := UnknownIdents & { a };
      OUT.WriteLn ("Variable not found: ", a);
      END;
   ELSIF #Fields > 1 THEN
    OUT.WriteLn ("Warning: more than a single matching decl: ", a);
   ELSE
    MarkDataFieldUsage (Fields[1], Id);
    END;
  END;
END MarkDataIdent;  

PROCEDURE OutputList (FName, File, Title, l);
  BEGIN
  IF #l > 0 THEN
    File.WriteLn ("<HR><H3>", Title, "</H3><UL>");
    FOR e IN l DO
      File.WriteLn ('<LI><A HREF="' , FName , '#ID', e.Nr, '">',
                  'Line ', e.LineNr, '</A></LI>');
      END;
    File.WriteLn ("</UL>");
    END;
  END OutputList;

PROCEDURE ColorComments;
  VAR
    a;
  BEGIN
  FOR i := 1 TO PATCH.LineCount DO
    a := PATCH.GetLines (i);
    IF (a <> VOID) AND (#a > 0) AND (a[1] = '*') THEN
      ColorLine (i, 'GREEN');
      END;
    END;
  END ColorComments;  

ON CicsStatement DO
  MarkCicsStatement (X);
  END;    

ON LabelIdent DO
  MarkLabel (X);
  END;  
  
ON DataIdent DO
  MarkDataIdent (X);
  END;  

PROCEDURE PatchNt (Nt,  BeforeStr, AfterStr);
  BEGIN
  PATCH.Insert (Nt.LineNr, Nt.ColNr, BeforeStr);
  PATCH.Insert (Nt.EndLineNr, Nt.EndColNr+1, AfterStr);
  END PatchNt;

PROCEDURE ColorNt (Nt, Col);
  BEGIN
  PatchNt (Nt, '<FONT COLOR="' & Col & '">', '</FONT>');
  END ColorNt;  

PROCEDURE MarkLine (LineNr, BeforeString, AfterString);
  VAR
    a;
  BEGIN
  a := PATCH.GetLines (LineNr);
  PATCH.Insert(LineNr, 1, BeforeString);
  PATCH.Insert(LineNr, #a+1, AfterString);
  END MarkLine;

PROCEDURE ColorLine (LineNr, Col);
  BEGIN
  MarkLine (LineNr, '<FONT COLOR="' & Col & '">', '</FONT>');
  END ColorLine;

PROCEDURE SaveHtml (FName, 
                    LIndexFName, 
                    DIndexFName,
                    TViewFName,
                    SpecList);
  VAR
    a, b, Fields;
  BEGIN
  FILE1.Redirect (LIndexFName);
  FILE2.Redirect (DIndexFName);
  PATCH.InsertLines(1, {"<!RainCode Generated document>",
                        "<HTML><HEAD><TITLE>" & ROOT.SourceName &"</TITLE>",
                        "</HEAD><BODY>",
                        '<H2><A HREF="' & LIndexFName & '">Goto inventory and label index...</A></H2><BR>',
                        '<H2><A HREF="' & DIndexFName & '">Goto data index...</A></H2><BR>',
                        '<H2><A HREF="' & TViewFName & '">Goto tree view...</A></H2><BR>',
                        '<H2><A HREF=#PROCDIVI>Procedure division...</A></H2><HR>',
                        "<PRE>"});
  MarkLine (ROOT.ProcedureDivision.LineNr, "<A NAME=PROCDIVI>", "</A>");
  FOR Bl IN ROOT.ProcedureDivision.Blocks DO
    Bl.HRef := '"' & FName & "#ID" & Bl.Nr & '"';
    END;
  
FOR Bl IN ROOT.ProcedureDivision.Blocks | NOT (X CAN Usages) DO
  ColorNt (Bl.LabelIdent, "GRAY");
  END;

  FOR Bl IN ROOT.ProcedureDivision.Blocks | X CAN Usages DO
    Bl.Usages := LIST.Sort(Bl.Usages);
    
ASSERT FOR_ALL IN Bl.Usages :- X <> Bl.LabelIdent;
FOR Id IN Bl.Usages DO
  PatchNt (Id, "<A " 
                    & " NAME=ID" & Id.Nr 
                    & ' HREF="#ID' & Bl.Nr & '">', "</A>");
  END;
a := Bl.LabelIdent;
IF #Bl.Usages = 1 THEN
  PatchNt (a,
      '<a NAME="ID' & Bl.Nr & '"' &
      ' HREF=#ID' & (Bl.Usages[1]).Nr & '>',
      '</a>');
 ELSE      
  PatchNt(a,
         '<a NAME="ID' & Bl.Nr & '"' &
          ' HREF="' & LIndexFName & "#ID" & Bl.Nr & '">',
          '</a>');
  END;      

    END;
  
FILE1.WriteLn ("<!RainCode Generated document>",
              "<HTML><HEAD><TITLE> Index of " & ROOT.SourceName & " labels</TITLE>",
                        "</HEAD><BODY>");
FOR IN SpecList DO
  OutputList(FName, FILE1, X[1], X[2]);
  END;
FOR Bl IN ROOT.ProcedureDivision.Blocks | (X CAN Usages) AND
                                          (#X.Usages > 1) DO
  
FILE1.WriteLn ('<HR>Usages of <A NAME=ID', Bl.Nr, 
                   ' HREF=', Bl.HRef, '>',
                   Bl.Label, "</A><BR><UL>");
FOR Id IN Bl.Usages DO
  FILE1.Write ("<LI>",
                     '<A HREF="', FName, '#ID', Id.Nr, '">',
                     "Line " , Id.LineNr);
  b := EnclosingBlock (Id);
  IF (b <> VOID) AND (b.LabelIdent <> VOID) THEN             
    FILE1.Write (" (", b.LabelIdent.Image, ")");
    END;
  FILE1.WriteLn ("</A></LI>");
  END;               
FILE1.WriteLn ("</UL>");

  END;
FILE1.WriteLn ("</BODY>");
FILE1.Redirect;

FILE2.WriteLn ("<!RainCode Generated document>",
              "<HTML><HEAD><TITLE> Index of " & ROOT.SourceName & " variables</TITLE>",
                        "</HEAD><BODY>");
Fields := ROOT.DataDivision.WorkingStorageSection.Data.Fields | X CAN Usages;                      
IF ROOT.DataDivision.LinkageSection <> VOID THEN
  Fields := Fields & ROOT.DataDivision.LinkageSection.Data.Fields | X CAN Usages;                      
  END;
ASSERT FOR_ALL IN Fields :- (#X.Usages > 0);
FOR Field IN LIST.Sort(Fields) DO
  
a := Field.Id;
PatchNt (a, '<A NAME=D' & a.Nr  &
                ' HREF="' & DIndexFName & '#D' & a.Nr & '">',
                '</A>');
FILE2.WriteLn ("<HR><H3>Usages of <A NAME=D", a.Nr,
                   ' HREF="', FName, '#D', a.Nr, '">', 
                   a.Image, "</A></H3><UL>");
FOR Id IN Field.Usages DO
  ASSERT Id IS DataIdent;
  ASSERT Id <> a;
  PatchNt (Id, '<A HREF=#D' & a.Nr & 
                    ' NAME="D' & Id.Nr & '">', '</A>');
  FILE2.Write ("<LI>",
                     '<A HREF="', FName, '#D', Id.Nr, '">',
                     "Line ", Id.LineNr);
  b := EnclosingBlock (Id);
  IF (b <> VOID) AND (b.LabelIdent <> VOID) THEN
    FILE2.Write (" (", b.LabelIdent.Image, ")");
    END;               
  FILE2.WriteLn("</A></LI>");
  END;
FILE2.WriteLn ("</UL>");  

  END;
FILE2.WriteLn ("</BODY>");                      
FILE2.Redirect;

  OUT.WriteLn (PATCH.PatchCount, " patches applied");    
  PATCH.Save (FName);
  END SaveHtml;

PROCEDURE TERMINATE;
  VAR
    StaticCalls,
    DynamicCalls,
    Targets,
    Radix,
    CicsStats,
    SpecList;
  BEGIN
  
Radix := ROOT.SourceName;

Radix := Radix[1..#Radix-4];

Radix := STR.Words(Radix, '\/');

Radix := Radix[#Radix];

Radix := STR.Words(Radix, '.');
Radix := Radix[1];

  ColorComments;
  
CicsStats := ROOT.SubNodes | X IS CicsStatement;

SpecList := {
               {
                   "CICS SEND MAP statements", 
                    CicsStats | ((X IS CicsSend) AND NOT X.Text)
               },
               {
                   "CICS SEND TEXT statements", 
                    CicsStats | ((X IS CicsSend) AND X.Text)
               },
               {
                   "CICS RETRIEVE statements", 
                    CicsStats | (X IS CicsRetrieve)
               },
               {
                   "CICS RETURN statements", 
                    CicsStats | (X IS CicsReturn)
               },
               {
                   "CICS START statements", 
                    CicsStats | (X IS CicsStart)
               },
               {
                   "CICS ASKTIME statements", 
                    CicsStats | (X IS CicsAsktime)
               },
               {
                   "CICS WRITEQ statements", 
                    CicsStats | (X IS CicsWriteQ)
               }
             };

CicsStats := LIST.Diff(CicsStats, LIST.RecursiveFlat(SpecList));
SpecList := SpecList & {{"Other CICS statements", CicsStats}};

StaticCalls := ROOT.SubNodes | X IS CallStatement;
FOR IN StaticCalls DO
  PATCH.Insert (X.LineNr, X.ColNr, 
                "<A NAME=ID" & X.Nr & ">");
  PATCH.Insert (X.LineNr, X.ColNr+4, 
                "</A>");
  END;
DynamicCalls := StaticCalls | NOT (X.ProcToken IS StringLiteral);
StaticCalls := LIST.Diff(StaticCalls, DynamicCalls);
ASSERT FOR_ALL IN StaticCalls :- X.ProcToken IS StringLiteral;
Targets := StaticCalls || STR.UpperCase (X.ProcToken.Image);
Targets := LIST.Unique (Targets);
SpecList := SpecList & 
              (Targets || 
                {
                  "Calls to " & X, 
                  StaticCalls | [y] y.ProcToken.Image =@ X
                });
SpecList := SpecList & {{"Dynamic calls", DynamicCalls}};                          

SaveHtml (Radix & ".html", 
          "LX" & Radix & ".html",
          "DX" & Radix & ".html",
          "TX" & Radix & ".html",
          SpecList);
Tree.ProduceTreeOutput("TX" & Radix & ".html");

  END TERMINATE;