This is a very typical example of RainCode's ability not to just find things in a piece of COBOL source code, but to actually correct it automatically as well.
<>= <On clauses> <Visiting anALTERstatement> <Patching the source code> <Structure-related procedures> <TERMINATEprocedure>
This code is written to a file (or else not used).Whenever an ALTER statement is found, call the
VisitAlter
procedure.
<On clauses>= ON AlterStatement DO VisitAlter (X); END;
Used above.
AlteredBlocks holds a list of all the statement blocks
that contain a single GOTO statement, and which are
altered by an ALTER statement.
<Visiting an ALTER statement>=
VAR
AlteredBlocks := {};
Used above; next definition.
<Visiting anALTERstatement>+= PROCEDURE VisitAlter(Alt); VAR target, bl; BEGIN target := Alt.Source.Image; bl := ROOT.ProcedureDivision.FindBlock (target); IF bl = VOID THEN <Error handling if the block cannot be found> ELSE <AttachAlttobl> AlteredBlocks := AlteredBlocks & { bl }; END; END VisitAlter;
Used above; previous definition.
<Error handling if the block cannot be found>=
ERR.WriteLn ("Label not found: [", target, "]");
Used above.This attachment is performed by an annotation. The annotation cannot be used just like that; one must first check whether it has been defined by using the CAN operator.
<AttachAlttobl>= IF NOT (bl CAN Alters) THEN bl.Alters := {}; END; bl.Alters := bl.Alters & { Alt }; ASSERT bl CAN Alters;
Used above.Then, after that the entire source code has been visited, all ALTER statement have been handled, and the various annotation have been set, we can consider whether we must take action or not. The rule is rather simple: if there is at least a single recognized ALTER statement, we proceed with the patching mechanism.
<TERMINATEprocedure>= PROCEDURE TERMINATE; VAR Count := 1, VarName, Stat, Targets, a, i, l, OriginalTarget; BEGIN IF AlteredBlocks <> VOID THEN FOR Bl IN LIST.Unique(AlteredBlocks) DO <Handle blockBl> END; END; IF PATCH.PatchCount > 0 THEN OUT.WriteLn ("Saving " & PATCH.PatchCount & " patches"); PATCH.Save (ROOT.SourceName & '.p'); END; END TERMINATE;
Used above.
ExtractAlterGoto will return the GOTO statement in
the block Bl that is altered by at least a single
ALTER statement. If no such statement can be found in
this block, ExtractAlterGoto returns VOID.
<Handle block Bl>=
Stat := ExtractAlterGoto (Bl);
Used above; next definition.
<Handle block Bl>+=
IF Stat = VOID THEN
OUT.WriteLine ("Cannot alter block: " , X.Label);
ELSE
Used above; previous and next definitions.
<Handle blockBl>+= VarName := "ALTER-CTRL-" & Count; InsertVarDecl (VarName); OriginalTarget := STR.UpperCase(Stat.Target.Image); Targets := (Bl.Alters || STR.UpperCase(X.NewSource.Image)); Targets := LIST.Unique(Targets); Targets := LIST.Diff(Targets, {OriginalTarget}); Targets := { OriginalTarget } & Targets; <ReplaceALTERs related toBlbyMOVEs> <Replace the originalGOTOby a conditional one> Count := Count + 1; END;
Used above; previous definition.*
<ReplaceALTERs related toBlbyMOVEs>= FOR AlterStmt IN Bl.Alters DO a := STR.UpperCase(AlterStmt.NewSource.Image); i := LIST.Index (Targets, a); PATCH.ReplaceNt (AlterStmt,"MOVE " & i-1 & " TO " & VarName); END;
Used above.
<Replace the original GOTO by a conditional one>=
a := {};
FOR IN 1 TO #Targets DO
IF a = {} THEN
l := 'IF ';
ELSE
l := STR.Pad(Stat.ColNr ) & 'ELSE IF ';
END;
l := l & VarName & " = " & X-1 & " GO TO " & Targets[X];
a := a & {l};
END;
PATCH.ReplaceNt (Stat, a);
Used above.
<Patching the source code>=
PROCEDURE InsertVarDecl (VarName);
VAR
LineNr;
BEGIN
ASSERT SYS.IsString (VarName);
LineNr := (ROOT.DataDivision.WorkingStorageSection.Data.Fields[1]).LineNr;
PATCH.InsertLines (LineNr, {'01 ' & VarName & ' PIC 99 USAGE COMP VALUE 0.'});
END InsertVarDecl;
Used above.The
ExtractAlterGoto procedure takes a block Bl, supposedly
altered by an ALTER statement. Such a block must contain
a single GOTO statement. This procedure ensures that
Bl matches this pattern, and returns this GOTO statement.
In all other cases, it returns VOID.
<Structure-related procedures>=
PROCEDURE ExtractAlterGoto (Bl);
BEGIN
ASSERT Bl IS StatementBlock;
IF #Bl.StatementList.List = 1 THEN
RESULT := Bl.StatementList.List[1];
IF NOT (RESULT IS GotoStatement) THEN
RESULT := VOID;
END;
END;
END ExtractAlterGoto;
Used above.
Alt to bl>: U1, D2
Bl>: U1, D2, D3, D4
ALTERs related to Bl by MOVEs>: U1, D2
GOTO by a conditional one>: U1, D2
TERMINATE procedure>: U1, D2
ALTER statement>: U1, D2, D3