MODULE m2pp;
(*-------------------------------------------------------------------------*)
(* Program to process Modula-2 style pragmas for conditional compilation *)
(* *)
(* Pragma start and end lines need to be on separate lines. *)
(* *)
(* The form of a conditional complilation pragma is described by *)
(* *)
(* IfStatement = <* IF Expression THEN *> *)
(* text *)
(* <* ELSE *> *)
(* text *)
(* <* END *> *)
(* Expression = (expression {AND|OR} expression}) *)
(* expression = {"NOT"} "("Indent")" *)
(* Indent = option *)
(* text = "program code" *)
(* *)
(* Pragmae can be nested. *)
(* *)
(* Usage *)
(* *)
(* "m2pp {-d} {-b} -D option{|-D option} {-U option{| -U option}" *)
(* *)
(* Parameter *)
(* *)
(* -d : debug output (useless for "normal" user *)
(* -b : replace unused code by blank lines *)
(* -D : define compilation option *)
(* -U : undefine compilation option *)
(* *)
(* ~ If -b is not given unsed code is completely replaced. This gives *)
(* readable code but may not be a good idea if you are still developing *)
(* code and want to debug it *)
(* ~ An option with -D is regarded to be TRUE *)
(* ~ An option with -U is regarded to be FALSE *)
(*-------------------------------------------------------------------------*)
(* Letzte Veraenderung: *)
(* *)
(* 21.09.16, MRi: Initial working version with inlined pragma parameters *)
(* 22.09.16, MRi: ELSE und Klammern um expression eingefuegt *)
(* 23.09.16, MRi: EvaluateExpression fuer die Auswertung des logischen *)
(* Ausdrucks eingefuegt - Vereinfachung des Ablaufs. *)
(* Zudem sind jetzt AND und OR Verknuepfungen moeglich *)
(* 24.09.16, MRi: Auswertung der Kommandozeilenparameter eingefuegt *)
(* Ausschreiben von Lerrzeilen korrigiert *)
(* 25.09.16, MRi: SkipNestedBlocks eingefuegt damit ein eingebetteter *)
(* IF-Block nicht verarbeitet wird wenn umgebende Block *)
(* auch nicht verarbeitet werden soll !!! *)
(* 26.09.16, MRi: Usage eingefuegt *)
(* 03.02.19, MRi: Usage erweitert *)
(*-------------------------------------------------------------------------*)
(* Offene Punkte *)
(* *)
(* - Weiter austesten - da gibt es bestimmt noch weitere Macken ... ;-) *)
(* Leerzeilen - ist das immer korrekt wenn angefordert *)
(* - Was ist mit Pragmae die nichts mit bedingter Kompilierung zu tun *)
(* haben ? *)
(* - Option "-U" ausarbeiten so dass man alle in einer Quelldatei vor- *)
(* handenen Optionen angeben muss und diese getestet werden koennen. *)
(* - Einfuegen von etwas mehr Fehlerbehandlung ... *)
(*-------------------------------------------------------------------------*)
(* Author : Michael Riedl *)
(*-------------------------------------------------------------------------*)
(* Licence : GNU General Public License (GPL) *)
(*-------------------------------------------------------------------------*)
(* $Id: m2pp.mod,v 1.8 2019/02/03 09:32:38 mriedl Exp mriedl $ *)
FROM ArgAccess IMPORT GetArgCount,GetArgument;
IMPORT Errors;
FROM FileSystem IMPORT File,Input,Output,StdErr;
IMPORT Strings;
IMPORT FIO2;
FROM FIO2 IMPORT ReadLine,WrLn,WrStr,EOF;
IMPORT Keywords;
FROM TokenLib IMPORT Token,StringTok;
IMPORT TIO;
CONST WSt = Errors.WriteString;
WCh = Errors.WriteChar;
WLn = Errors.WriteLn;
WrC = Errors.WriteCard;
WrB = Errors.WriteBoolean;
PROCEDURE Usage();
BEGIN
WLn; WLn;
WSt(" Usage: m2pp {-d} {-b} -D opt1 {- D opt2} -U opt3 {-U opt4}");
WSt(" < input > output"); WLn; WLn;
WLn;
WSt(" -d : debug output (useless for 'normal' user"); WLn;
WSt(" -b : replace unused code by blank lines"); WLn;
WSt(" (otherwise more readable code is generated)"); WLn;
WSt(" -D : define compilation option"); WLn;
WSt(" -U : undefine compilation option"); WLn;
WLn;
Errors.FatalError("Programm abgebrochen !");
END Usage;
TYPE Pragma = RECORD
option : ARRAY [0..31] OF CHAR;
notOpt : BOOLEAN;
END;
PROCEDURE ParseProgArgs(VAR nPragma : CARDINAL;
VAR Pragmae : ARRAY OF Pragma;
VAR wrEmptyLine : BOOLEAN;
VAR debug : BOOLEAN);
VAR iarg : CARDINAL;
Argument : ARRAY [0..31] OF CHAR;
PROCEDURE FehlerMeldung(FFlag : ARRAY OF CHAR);
BEGIN
Errors.WriteLn();
Errors.WriteString("Eingabefehler bei Argument ");
Errors.WriteCard(iarg);
Errors.WriteString(" (");
Errors.WriteString(Argument);
Errors.WriteString(") ");
Errors.WriteString(FFlag);
Errors.WriteString(" !");
Usage();
END FehlerMeldung;
VAR ikey : INTEGER;
iprag : CARDINAL;
ArgCount : CARDINAL;
BEGIN
Keywords.DefineKey("-D",1); (* Parserhashtabellen initialisieren. *)
Keywords.DefineKey("-U",2);
Keywords.DefineKey("-b",3);
Keywords.DefineKey("-d",4);
ArgCount:=GetArgCount();
IF (ArgCount < 3) THEN Usage(); END;
iprag := 0;
iarg := 1;
LOOP
IF (iarg > ArgCount-1) THEN EXIT; END;
GetArgument(iarg,Argument);
IF Keywords.IsKey(Argument,ikey) THEN
CASE ikey OF
| 1: (* -D *)
IF (iarg = ArgCount-1) THEN
FehlerMeldung("fehlender Parameter")
END;
INC(iarg);
GetArgument(iarg,Argument);
Strings.Assign(Argument,Pragmae[iprag].option);
INC(iprag);
| 2: (* -U *)
Pragmae[iprag].notOpt:=TRUE;
IF (iarg = ArgCount-1) THEN
FehlerMeldung("fehlender Parameter")
END;
INC(iarg);
GetArgument(iarg,Argument);
Strings.Assign(Argument,Pragmae[iprag].option);
INC(iprag);
| 3: (* -b *)
wrEmptyLine := TRUE;
| 4: (* -d *)
debug := TRUE;
END; (* CASE *)
ELSE
FehlerMeldung("Kommandozeilenparameter unbekannt")
END; (* IF *)
INC(iarg);
END; (* LOOP *)
nPragma := iprag;
END ParseProgArgs;
CONST MaxPrag = 16;
LineLen = 256;
MaxToken = LineLen DIV 2;
Trenner = " ";
WriteLine = WrStr; (* Maybe we need another routine here ;-) *)
(* future use if Pragma is not restricte to be on separate line *)
starttok = 0;
VAR wrEmptyLine : BOOLEAN;
debug : BOOLEAN;
VAR OpenIF : CARDINAL;
Line : ARRAY [0..LineLen-1] OF CHAR;
Ein,Aus : File;
ntok : CARDINAL;
Tokens : ARRAY [0..MaxToken] OF Token;
nPragma : CARDINAL;
Pragmae : ARRAY [1..MaxPrag] OF Pragma;
LineNo : CARDINAL; (* number of lines read *)
PROCEDURE WrEmptyLn(Aus : File);
BEGIN
IF wrEmptyLine THEN
IF debug THEN
WrStr(Aus,"(* weggelassen >>>");
WriteLine(Aus,Line);
WrStr(Aus,"<<< weggelassen *)");
END;
WrLn(Aus);
END;
END WrEmptyLn;
PROCEDURE IsPragmaLine(Line : ARRAY OF CHAR) : BOOLEAN;
(*----------------------------------------------------------------*)
(* Check if Line contains a start pragma "<\*" *)
(*----------------------------------------------------------------*)
CONST startcomment = "(*";
VAR found,done : BOOLEAN;
(* comment : BOOLEAN; *)
i : CARDINAL;
BEGIN
found := FALSE;
StringTok(Line,Trenner,FALSE,Tokens,ntok,done);
IF debug THEN
WSt("--- ");
FOR i:=1 TO ntok DO WSt(Tokens[i-1]); WCh(" "); END;
WSt("--- ");
END;
IF NOT done THEN
(* Fehlerbehandlung nachziehen ... *)
END;
IF (ntok >= 3) THEN
found:=Strings.Equal("<*",Tokens[0]);
(* (* Future use *)
* i:=0;
* REPEAT
* comment:=Strings.Equal(startcomment,Tokens[i]);
* found:=Strings.Equal("<\*",Tokens[i]);
* INC(i);
* UNTIL found OR (i >= ntok) OR comment;
* starttok := i-1;
*)
END;
RETURN found;
END IsPragmaLine;
PROCEDURE IsDefined(token : Token) : BOOLEAN;
(*----------------------------------------------------------------*)
(* Check if token is a defined pragma *)
(*----------------------------------------------------------------*)
VAR i : CARDINAL;
found : BOOLEAN;
BEGIN
i:=0;
REPEAT
INC(i);
found := Strings.Equal(token,Pragmae[i].option);
UNTIL found OR (i = nPragma);
IF found THEN
IF debug THEN WSt("gefunden, "); WSt(Pragmae[i].option); WLn; END;
IF (Pragmae[i].notOpt) THEN
(* Hier sollte man an das rufende Programm singnalisieren *)
(* dass die Option bekannt ist aber negiert wurde. *)
found:=FALSE;
END;
END;
RETURN found;
END IsDefined;
PROCEDURE EvaluateExpression() : BOOLEAN;
(*----------------------------------------------------------------*)
(* Evaluate if the expression betweenn IF and THEN is TRUE OR *)
(* FALSE. A maximum of 16 logical atoms can be evaluated. *)
(*----------------------------------------------------------------*)
TYPE AndOrVal = RECORD
ifAND : BOOLEAN;
ifOR : BOOLEAN;
END;
VAR i,k,ie : CARDINAL;
not,isDef,retval : BOOLEAN;
LogicalAtom : ARRAY [1..16] OF BOOLEAN;
LogicalGlue : ARRAY [1..16] OF AndOrVal;
BEGIN
i:=0;
REPEAT INC(i); UNTIL Strings.Equal(Tokens[i],"THEN");
ie:=i-1;
k:=0;
i:=2; (* Start of logical expression in Token list *)
LOOP
INC(k);
not:=FALSE;
IF Strings.Equal(Tokens[i],"NOT") THEN
not:=TRUE;
INC(i);
END;
isDef := IsDefined(Tokens[i]);
IF not THEN isDef := NOT isDef; END;
IF debug THEN
WSt("EvaluateExpression : Token = ");
WSt(Tokens[i]); WSt(" = "); WrB(isDef); WLn;
END;
LogicalAtom[k]:=isDef;
LogicalGlue[k].ifOR :=FALSE;
LogicalGlue[k].ifAND:=FALSE;
IF (i >= ie) THEN EXIT; END;
INC(i);
IF Strings.Equal(Tokens[i],"AND") THEN
(* logical combiation with next element *)
LogicalGlue[k].ifAND:=TRUE; INC(i);
ELSIF Strings.Equal(Tokens[i],"OR") THEN
LogicalGlue[k].ifOR :=TRUE; INC(i);
END;
END;
(* Now evaluate the overall expression *)
retval:=LogicalAtom[1];
FOR i:=1 TO k-1 DO
IF LogicalGlue[i].ifAND THEN
retval:=retval AND LogicalAtom[i+1];
ELSIF LogicalGlue[i].ifOR THEN
retval:=retval OR LogicalAtom[i+1];
END;
END;
IF debug THEN
FOR i:=1 TO k DO
WrB(LogicalAtom[i]);
IF LogicalGlue[i].ifAND THEN WSt(" AND "); END;
IF LogicalGlue[i].ifOR THEN WSt(" OR "); END;
END;
WSt("= "); WrB(retval); WLn;
END;
RETURN retval;
END EvaluateExpression;
PROCEDURE ProcessPragma();
(*----------------------------------------------------------------*)
(* Process the pragma - either write or skip lines ... *)
(*----------------------------------------------------------------*)
PROCEDURE SkipNestedBlocks();
(* Skip nested IF-Blocks, even if themsefe nested *)
CONST debug = FALSE;
VAR openif : CARDINAL; (* Buchhaltung IF-Bloecke *)
BEGIN
openif:=OpenIF + 1;
IF debug THEN
WSt("Start SkipNestedBlocks ... ");
WSt("# openif = "); WrC(openif); WLn;
END;
LOOP
ReadLine(Ein,Line);
IF EOF THEN RETURN; END; (* Das sollte nicht vorkommen ! *)
INC(LineNo);
IF debug THEN
WrC(LineNo); WSt(" SkipNB ... ");
WriteLine(StdErr,Line); WLn;
END;
IF (IsPragmaLine(Line)) THEN
(* inklusive Zerlegung in Token *)
IF (Strings.Equal(Tokens[1],"IF") ) THEN
INC(openif);
IF debug THEN
WSt("+ openif = "); WrC(openif); WLn;
END;
ELSIF (Strings.Equal(Tokens[1],"END")) THEN
DEC(openif);
IF debug THEN
WSt("- openif = "); WrC(openif); WLn;
END;
IF (openif = OpenIF) THEN
(* Jetzt haben wir den eingebetteten Block verarbeitet *)
WrEmptyLn(Aus);
EXIT;
END;
END;
END;
WrEmptyLn(Aus);
END;
IF debug THEN
WSt("& openif = "); WrC(openif); WLn;
WSt("... Ende SkipNestedBlocks");
END;
END SkipNestedBlocks;
VAR isDef : BOOLEAN;
skipline : BOOLEAN;
rekursion : BOOLEAN;
inctok : CARDINAL;
BEGIN
inctok:=0;
IF Strings.Equal(Tokens[starttok+1],"IF") THEN
INC(OpenIF);
isDef:=EvaluateExpression();
WrEmptyLn(Aus); (* replace <\* IF ... *)
LOOP (* Sicher noch nicht korrekt *)
rekursion:=FALSE;
ReadLine(Ein,Line);
IF EOF THEN EXIT; END;
INC(LineNo);
IF debug THEN
WrC(LineNo); WSt(": >>>>"); WSt(Line); WSt("<<<<"); WLn;
END;
skipline:=FALSE;
IF (IsPragmaLine(Line)) THEN (* Hier wird auch in Token zerlegt ! *)
IF Strings.Equal(Tokens[starttok+1],"END") THEN
IF debug THEN WSt("END gefunden"); WLn; END;
WrEmptyLn(Aus);
DEC(OpenIF);
EXIT;
ELSIF Strings.Equal(Tokens[starttok+1],"ELSE") THEN
(* Process content with switch write option *)
isDef := NOT isDef;
skipline:=TRUE; (* Zeile nicht ausschreiben *)
ELSIF Strings.Equal(Tokens[starttok+1],"IF") THEN (* Rekursion *)
IF (isDef = FALSE) THEN (* Skip nested IF Block(s) *)
(* Ueberlese bis zum Abschliessenden END wobei weitere *)
(* eingebettete IF-Bloeche ebenfalls ueberlesen werden *)
(* muessen. *)
SkipNestedBlocks();
IF EOF THEN EXIT; END; (* Fehler !!! *)
ELSE
rekursion:=TRUE;
IF debug THEN WSt("Rekursion"); WLn; END;
ProcessPragma();
IF debug THEN WSt("zurueck aus der Rekursion"); WLn; END;
skipline:=TRUE; (* Zeile nicht ausschreiben *)
END;
ELSE
(* Eventuell Code f��r andere Pragmae die nichts mit bedingter *)
(* Kompilierung zu tun haben - ueberlesen und ausschreiben *)
END;
END;
IF isDef AND NOT skipline THEN
IF debug THEN WrStr(Aus,"* "); END;
WriteLine(Aus,Line); WrLn(Aus);
ELSE
(* Generate empty lines for code left out if requested ... *)
IF NOT rekursion THEN
WrEmptyLn(Aus);
END;
END;
END; (* LOOP *)
END; (* AND IF "IF" clause *)
END ProcessPragma;
PROCEDURE SetPragmae();
(*----------------------------------------------------------------*)
(* Fill list of Pragmae defined on command line and set the *)
(* global variables wrEmptyLine and debug *)
(*----------------------------------------------------------------*)
VAR i : CARDINAL;
BEGIN
FOR i:=1 TO MaxPrag DO
Pragmae[i].option[0] := 0C;
Pragmae[i].notOpt := FALSE;
END;
wrEmptyLine := FALSE;
debug := FALSE;
ParseProgArgs(nPragma,Pragmae,wrEmptyLine,debug);
FOR i:=1 TO nPragma DO (* surround option by () backets *)
Strings.Insert("(",0,Pragmae[i].option);
Strings.Append(")", Pragmae[i].option);
END;
END SetPragmae;
BEGIN
Ein:=Input;
Aus:=Output;
FIO2.warn := FALSE;
wrEmptyLine := FALSE;
debug := FALSE;
LineNo := 0;
SetPragmae();
OpenIF := 0;
LOOP
ReadLine(Ein,Line);
IF EOF THEN EXIT; ELSE INC(LineNo); END;
IF debug THEN
WrC(LineNo); WSt(": >>>>"); WSt(Line); WSt("<<<<"); WLn;
END;
IF (IsPragmaLine(Line)) THEN
ProcessPragma();
IF EOF THEN EXIT; END;
ELSE
IF debug THEN WrStr(Aus,"# "); END;
WriteLine(Aus,Line); WrLn(Aus);
END;
END; (* LOOP *)
IF (OpenIF # 0) THEN (* Fehlerbehandlung *)
Errors.ErrOut("Nicht alles IF-Bloecke wurden geschlossen");
END;
END m2pp.