0.1 Preamble

This script takes a COBOL program, and produces an HTML browsable version out of it. This browsable version is made of three files, namely:

• The source file itself, where identifiers in the code are clickable to go to the corresponding declaration
• An index file for data declarations, that allows you to find where a given data declaration has been used within the program
• An index file for labels, that provides similar functionality for the labels that are declared.

This script shows several key features of RainCode, namely, the ability to look for the declaration of a variable given its name, the patch mechanism, classifications using the IS operator, and some other features....

This script is organized in such a way that it can be read almost linearly, from top to bottom, describing each feature as thoroughly as possible. Hence, it can be used by the first-time RainCode programmer as a non-trivial real-world example for inspiration.

<>=

USE Tree;

  <Global variables and constants>
  <Various procedures>
  <Event-driven code chunks>
  <Patching procedures>
  <SaveHtml procedure>
  <TERMINATE>

This code is written to a file (or else not used).

SkipIdents denotes identifiers for which the XREF capability must be disabled, because they are predefined identifiers, are so commonly used that any XREF attempt would produce far too much information to remain useful.

RainCode constants are just read-only variables, but their value can be produced by an arbitrarily complex expression.

<Global variables and constants>=

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

Used above.

Patching the image

The following procedure provides higher-level services for patching the source code. PatchNt patches a non-terminal, by inserting a string before and after it, using the methods that return its position within the source code.

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

Used above; next definition.

ColorNt uses PatchNt to color a non-terminal, by inserting a <FONT...> and </FONT> couple before and after this non-terminal.

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

Used above; previous and next definitions.

<Patching procedures>+=
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;

Used above; previous definition.

Querying the structure

EnclosingBlock takes a non-terminal as parameter, and returns the StatementBlock in which it is enclosed, by following the chain of the Father references.

If no such enclosing block can be found, for instance if the non-terminal is not related to a statement, EnclosingBlock returns VOID.

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

Used above; next definition.

<Various procedures>+=
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;

Used above; previous and next definitions.

Marking non-terminals

<Various procedures>+=
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;  

Used above; previous and next definitions.

<Various procedures>+=
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;  

Used above; previous and next definitions.

<Various procedures>+=
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;  

Used above; previous and next definitions.

<Various procedures>+=
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;

Used above; previous and next definitions.

<Event-driven code chunks>=
ON CicsStatement DO
  MarkCicsStatement (X);
  END;    

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

Used above.

The SaveHtml procedure does most of the hard job of this script. It patches the text representation of the source code by inserting the required HTML tags for every label or data identifier, generates the indexes, etc...

<SaveHtml procedure>=
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;
  <Mark the unreferenced labels in gray>
  FOR Bl IN ROOT.ProcedureDivision.Blocks | X CAN Usages DO
    Bl.Usages := LIST.Sort(Bl.Usages);
    <Consider block Bl, assuming it is referenced at least once>
    END;
  
  <Produce the label index file in FILE1>
  <Produce the data index file in FILE2>
  OUT.WriteLn (PATCH.PatchCount, " patches applied");    
  PATCH.Save (FName);
  END SaveHtml;

Used above.

*

<Mark the unreferenced labels in gray>=
FOR Bl IN ROOT.ProcedureDivision.Blocks | NOT (X CAN Usages) DO
  ColorNt (Bl.LabelIdent, "GRAY");
  END;

Used above.

We know for sure that Bl has been used referred to at least once, since the case where it has not been referred has been handled separately (see above).

All the identifiers that refer to Bl are stored in the Usages annotation attached to Bl.

<Consider block Bl, assuming it is referenced at least once>=
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;      

Used above.

<Produce the label index file in FILE1>=
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
  <List the usages of Bl>
  END;
FILE1.WriteLn ("</BODY>");
FILE1.Redirect;

Used above.

*

<List the usages of Bl>=
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>");

Used above.

<Produce the data index file in FILE2>=
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
  <Produce the data index information for Field>
  END;
FILE2.WriteLn ("</BODY>");                      
FILE2.Redirect;

Used above.

*

<Produce the data index information for Field>=
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>");  

Used above.

The following procedure visits the entire file in its textual representation, and marks all comment lines, that is, those of the lines that begin with an asterisk "*" in green.

<Various procedures>+=
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;  

Used above; previous definition.

<TERMINATE>=
PROCEDURE TERMINATE;
  VAR
    StaticCalls,
    DynamicCalls,
    Targets,
    Radix,
    CicsStats,
    SpecList;
  BEGIN
  <Extract the filename radix in Radix>
  ColorComments;
  <Generate SpecList for the generation>
  <Actually generate the HTML files>
  END TERMINATE;  

Used above.

The following chunks show how a RainCode variable can hold values of different types at runtime. Radix is initialized as a string, before being turned into a list, back to a string, back to a list again, and finally, it receives its definitive incarnation as a character string.

<Extract the filename radix in Radix>=
Radix := ROOT.SourceName;

Used above; next definition.

First, remove the 4 last characters of the file name, assuming of course that it is a three characters extension such as .cob or .cbl.

<Extract the filename radix in Radix>+=
Radix := Radix[1..#Radix-4];

Used above; previous and next definitions.

Then, split the remaining prefix using a slash or a backslash as separator...

<Extract the filename radix in Radix>+=
Radix := STR.Words(Radix, '\/');

Used above; previous and next definitions.

Take the last word resulting of this separation...

<Extract the filename radix in Radix>+=
Radix := Radix[#Radix];

Used above; previous and next definitions.

and return whatever can be found before a dot, if any.

<Extract the filename radix in Radix>+=
Radix := STR.Words(Radix, '.');
Radix := Radix[1];

Used above; previous definition.

The generation of the HTML files happens by calling the SaveHtml procedure. It takes four parameters:

• The filename for the HTML file that will contain the source code, built using Radix.
• The filename for the HTML file that will contain the label index, built by prepending "LX" to the filename built for the first parameter.
• The filename for the HTML file that will contain the data index, built by prepending "DX" to the filename built for the first parameter.
• A list of couples (implemented as lists themselves) that contain a title and list of non-terminals to put in the label index. In this example, we have used this feature to insert indexing information for all CICS statements in the label index; the same can be done for all SQL statements, for all data declarations of a given type, or any other kind of collection worth indexing.

Since all the statements gathered in this script are CICS statements, instead of searching them in all the nodes of the parse tree, we first build an intermediate list CicsStats that will be used to further reduce the scope when seraching for specific statements.

We then initialize SpecList before providing it as last parameter to the

<Generate SpecList for the generation>=
CicsStats := ROOT.SubNodes | X IS CicsStatement;

Used above; next definition.

We then initialize SpecList before providing it as last parameter to the SaveHtml procedure.

<Generate SpecList for the generation>+=
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)
               }
             };

Used above; previous and next definitions.

<Generate SpecList for the generation>+=
CicsStats := LIST.Diff(CicsStats, LIST.RecursiveFlat(SpecList));
SpecList := SpecList & {{"Other CICS statements", CicsStats}};

Used above; previous and next definitions.

<Generate SpecList for the generation>+=
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}};                          

Used above; previous definition.

<Actually generate the HTML files>=
SaveHtml (Radix & ".html", 
          "LX" & Radix & ".html",
          "DX" & Radix & ".html",
          "TX" & Radix & ".html",
          SpecList);
Tree.ProduceTreeOutput("TX" & Radix & ".html");

Used above.

• <>: D1
• <Actually generate the HTML files>: U1, D2
• <Consider block Bl, assuming it is referenced at least once>: U1, D2
• <Event-driven code chunks>: U1, D2
• <Extract the filename radix in Radix>: U1, D2, D3, D4, D5, D6
• <Generate SpecList for the generation>: U1, D2, D3, D4, D5
• <Global variables and constants>: U1, D2
• <List the usages of Bl>: U1, D2
• <Mark the unreferenced labels in gray>: U1, D2
• <Patching procedures>: U1, D2, D3, D4
• <Produce the data index file in FILE2>: U1, D2
• <Produce the data index information for Field>: U1, D2
• <Produce the label index file in FILE1>: U1, D2
• <SaveHtml procedure>: U1, D2
• <TERMINATE>: U1, D2
• <Various procedures>: U1, D2, D3, D4, D5, D6, D7, D8