PR modula2/113836 gm2 does not dump gimple or quadruples to a file

This patch completes the implementation of dumping the intermediate forms
to file.  It implements the filtering on symbol rules.  Filtering can be
performed through the full text name (given to the GCC tree) or qualified
modula-2 symbol or filename:qualident.

gcc/ChangeLog:

	PR modula2/113836
	* doc/gm2.texi (Compiler options): Add -fm2-debug-trace=,
	-fm2-dump, -fm2-dump-decl=, -fm2-dump-gimple=, -fm2-dump-quad=
	and -fm2-dump-filter=.

gcc/m2/ChangeLog:

	PR modula2/113836
	* gm2-compiler/M2AsmUtil.def: Remove export qualified and
	unused import.
	* gm2-compiler/M2LangDump.mod (AddRuleTextDump): New procedure.
	(AddRuleScopeQualidentDump): Add warning check against unmatched
	rule.
	(GenQualidentSymString): New procedure function.
	(IdentQualidentMatch): New procedure function.
	(IsRuleFilenameMatch): New procedure function.
	(CheckRuleMatch): New procedure function.
	(AddRuleFilenameDump): New procedure function.
	* gm2-gcc/m2misc.cc (m2misc_warning_m2_dump_filter): New function.
	* gm2-gcc/m2misc.def (warning_m2_dump_filter): New procedure.
	* gm2-gcc/m2misc.h (m2misc_warning_m2_dump_filter): New prototype.
	* gm2-gcc/m2pp.cc (VERBOSE_TYPE_DESC): New define.
	(m2pp_identifier): Define out verbose type info.
	(m2pp_constructor): Define out verbose type info.
	(m2pp_assignment): Define out verbose type info.
	* gm2-lang.cc (ENABLE_M2DUMP_ALL): Remove.
	* lang.opt (fm2-dump): Add.
	(fm2-dump-decl=): Add.
	(fm2-dump-gimple=): Add.
	(fm2-dump-quad=): Add.
	(fm2-dump-filter=): Add.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>

8 files changed, 191 insertions, 20 deletions

diff --git a/gcc/m2/gm2-compiler/M2AsmUtil.def b/gcc/m2/gm2-compiler/M2AsmUtil.def
index c23992e..9077c45 100644
--- a/gcc/m2/gm2-compiler/M2AsmUtil.def
+++ b/gcc/m2/gm2-compiler/M2AsmUtil.def
@@ -29,9 +29,7 @@ DEFINITION MODULE M2AsmUtil ;
                 to their equivalent representation in ASM format.
 *)
 
-FROM DynamicStrings IMPORT String ;
 FROM NameKey IMPORT Name ;
-EXPORT QUALIFIED GetFullSymName, GetFullScopeAsmName ;
 
 
 (*
diff --git a/gcc/m2/gm2-compiler/M2LangDump.mod b/gcc/m2/gm2-compiler/M2LangDump.mod
index ec3522b..e65f5b0 100644
--- a/gcc/m2/gm2-compiler/M2LangDump.mod
+++ b/gcc/m2/gm2-compiler/M2LangDump.mod
@@ -31,7 +31,7 @@ FROM DynamicStrings IMPORT String, Length, InitString, Mark, Slice, EqualArray,
 FROM SymbolTable IMPORT NulSym,
                         GetSymName, GetLibName,
                         GetScope, GetModuleScope, GetMainModule, GetDeclaredMod,
-                        GetLocalSym,
+                        GetLocalSym, FinalSymbol,
                         IsInnerModule,
                         IsVar,
                         IsProcedure,
@@ -43,15 +43,17 @@ FROM SymbolTable IMPORT NulSym,
 FROM M2Options IMPORT GetM2DumpFilter, GetDumpDir, GetDumpQuadFilename,
                       GetDumpDeclFilename, GetDumpGimpleFilename ;
 
+FROM M2AsmUtil IMPORT GetFullSymName ;
 FROM M2GCCDeclare IMPORT IncludeDumpSymbol ;
 FROM FormatStrings IMPORT Sprintf0, Sprintf1 ;
 FROM NameKey IMPORT Name, GetKey, MakeKey, makekey, KeyToCharStar, NulName ;
-FROM SymbolConversion IMPORT Gcc2Mod, Mod2Gcc ;
+FROM SymbolConversion IMPORT Gcc2Mod, Mod2Gcc, GccKnowsAbout ;
 FROM M2AsmUtil IMPORT GetFullScopeAsmName ;
 FROM M2LexBuf IMPORT FindFileNameFromToken ;
 FROM M2Printf IMPORT fprintf0, fprintf1, printf0, printf1, printf2 ;
 FROM M2Error IMPORT InternalError ;
 FROM M2Batch IMPORT Get ;
+FROM m2misc IMPORT warning_m2_dump_filter ;
 FROM StrLib IMPORT StrLen ;
 FROM libc IMPORT printf ;
 
@@ -147,12 +149,27 @@ END CloseDumpDecl ;
 
 
 (*
-   AddRuleTextDump -
+   AddRuleTextDump - filter on the textual name given to GCC.
 *)
 
 PROCEDURE AddRuleTextDump (rule: String) ;
-BEGIN
-
+VAR
+   sym      : CARDINAL ;
+   key      : Name ;
+   seenMatch: BOOLEAN ;
+BEGIN
+   sym := 1 ;
+   seenMatch := FALSE ;
+   key := makekey (string (rule)) ;
+   WHILE sym <= FinalSymbol () DO
+      IF IsProcedure (sym) AND (key = GetFullSymName (sym))
+      THEN
+         IncludeDumpSymbol (sym) ;
+         seenMatch := TRUE
+      END ;
+      INC (sym)
+   END ;
+   CheckRuleMatch (seenMatch, rule)
 END AddRuleTextDump ;
 
 
@@ -183,8 +200,10 @@ BEGIN
    END ;
    idstr := Slice (rule, start, 0) ;
    sym := GetLocalSym (modsym, makekey (string (idstr))) ;
-   IF sym # NulSym
+   IF sym = NulSym
    THEN
+      CheckRuleMatch (FALSE, rule)
+   ELSE
       IncludeDumpSymbol (sym)
    END
 END AddRuleScopeQualidentDump ;
@@ -228,17 +247,132 @@ END AddRuleScopeDump ;
 
 
 (*
+   GenQualidentSymString - returns the qualified sym string (including
+                           any nested procedure and modules).
+*)
+
+PROCEDURE GenQualidentSymString (sym: CARDINAL) : String ;
+VAR
+   identstr,
+   qualidentstr: String ;
+BEGIN
+   qualidentstr := InitStringCharStar (KeyToCharStar (GetSymName (sym))) ;
+   WHILE GetScope (sym) # NulSym DO
+      sym := GetScope (sym) ;
+      identstr := InitStringCharStar (KeyToCharStar (GetSymName (sym))) ;
+      ConCatChar (identstr, '.') ;
+      qualidentstr := ConCat (identstr, Mark (qualidentstr))
+   END ;
+   RETURN qualidentstr
+END GenQualidentSymString ;
+
+
+(*
+   IdentQualidentMatch - return TRUE if sym name matches symstr.
+*)
+
+PROCEDURE IdentQualidentMatch (sym: CARDINAL; symstr: String) : BOOLEAN ;
+VAR
+   success     : BOOLEAN ;
+   qualidentstr: String ;
+BEGIN
+   qualidentstr := GenQualidentSymString (sym) ;
+   success := Equal (qualidentstr, symstr) ;
+   qualidentstr := KillString (qualidentstr) ;
+   RETURN success
+END IdentQualidentMatch ;
+
+
+(*
+   IsRuleFilenameMatch - return TRUE if rule matches sym.
+*)
+
+PROCEDURE IsRuleFilenameMatch (rule: String; sym: CARDINAL) : BOOLEAN ;
+VAR
+   fname,
+   modstr,
+   symstr,
+   filename: String ;
+   tokenno : CARDINAL ;
+   dot,
+   colon   : INTEGER ;
+   success : BOOLEAN ;
+BEGIN
+   tokenno := GetDeclaredMod (sym) ;
+   filename := FindFileNameFromToken (tokenno, 0) ;
+   fname := NIL ;
+   symstr := NIL ;
+   modstr := NIL ;
+   success := FALSE ;
+   colon := Index (rule, ':', 0) ;
+   IF colon > 0
+   THEN
+      fname := Slice (rule, 0, colon) ;
+      IF Equal (fname, filename)
+      THEN
+         IF INTEGER (Length (rule)) > colon
+         THEN
+            symstr := Slice (rule, colon + 1, 0) ;
+            dot := ReverseIndex (symstr, '.', -1) ;
+            IF dot >= 0
+            THEN
+               success := IdentQualidentMatch (sym, symstr)
+            ELSE
+               success := GetSymName (sym) = makekey (string (symstr))
+            END
+         END
+      END
+   END ;
+   fname := KillString (fname) ;
+   modstr := KillString (modstr) ;
+   symstr := KillString (symstr) ;
+   RETURN success
+END IsRuleFilenameMatch ;
+
+
+(*
+   CheckRuleMatch - issue a warning if seenMatch is FALSE and this is the first time
+                    the rule is matched.
+*)
+
+PROCEDURE CheckRuleMatch (seenMatch: BOOLEAN; rule: String) ;
+VAR
+   message: String ;
+BEGIN
+   IF (NoOfDeclDumps = 1) AND (NOT seenMatch)
+   THEN
+      message := InitString ("no symbol matching: %qs has been found when applying the dump filter") ;
+      warning_m2_dump_filter (string (message), string (rule));
+   END
+END CheckRuleMatch ;
+
+
+(*
    AddRuleFilenameDump -
 *)
 
 PROCEDURE AddRuleFilenameDump (rule: String) ;
+VAR
+   sym      : CARDINAL ;
+   seenMatch: BOOLEAN ;
 BEGIN
-
+   sym := 1 ;
+   seenMatch := FALSE ;
+   WHILE sym <= FinalSymbol () DO
+      IF IsProcedure (sym) AND IsRuleFilenameMatch (rule, sym)
+      THEN
+         IncludeDumpSymbol (sym) ;
+         seenMatch := TRUE
+      END ;
+      INC (sym)
+   END ;
+   CheckRuleMatch (seenMatch, rule)
 END AddRuleFilenameDump ;
 
 
 (*
-   AddRuleSymToDump -
+   AddRuleSymToDump - call appropriate sub rule.  FileName if : present.
+                      Scope if . present otherwise assume a text rule.
 *)
 
 PROCEDURE AddRuleSymToDump (rule: String) ;
diff --git a/gcc/m2/gm2-gcc/m2misc.cc b/gcc/m2/gm2-gcc/m2misc.cc
index df77f32..1d337ff 100644
--- a/gcc/m2/gm2-gcc/m2misc.cc
+++ b/gcc/m2/gm2-gcc/m2misc.cc
@@ -23,6 +23,7 @@ along with GNU Modula-2; see the file COPYING3.  If not see
 
 #include "../m2-tree.h"
 #include "tree-iterator.h"
+#include "opts.h"
 
 #define m2misc_c
 #include "m2block.h"
@@ -70,3 +71,12 @@ m2misc_printStmt (void)
   if (m2block_cur_stmt_list () != NULL)
     debug_tree (m2block_cur_stmt_list ());
 }
+
+/* warning_m2_dump_filter issue a warning relating to the
+   -fm2_dump_filter=rule option.  */
+
+void
+m2misc_warning_m2_dump_filter (const char *message, const char *rule)
+{
+  warning (OPT_fm2_dump_filter_, message, rule);
+}
diff --git a/gcc/m2/gm2-gcc/m2misc.def b/gcc/m2/gm2-gcc/m2misc.def
index 26b0e44..77fd283 100644
--- a/gcc/m2/gm2-gcc/m2misc.def
+++ b/gcc/m2/gm2-gcc/m2misc.def
@@ -24,10 +24,9 @@ DEFINITION MODULE FOR "C" m2misc ;
 FROM m2tree IMPORT Tree ;
 FROM SYSTEM IMPORT ADDRESS ;
 
-
 PROCEDURE DebugTree (t: Tree) ;
 PROCEDURE error (message: ARRAY OF CHAR) ;
 PROCEDURE cerror (message: ADDRESS) ;
-
+PROCEDURE warning_m2_dump_filter (message, rule: ADDRESS) ;
 
 END m2misc.
diff --git a/gcc/m2/gm2-gcc/m2misc.h b/gcc/m2/gm2-gcc/m2misc.h
index f0aa82e..2213984 100644
--- a/gcc/m2/gm2-gcc/m2misc.h
+++ b/gcc/m2/gm2-gcc/m2misc.h
@@ -41,6 +41,7 @@ EXTERN void m2misc_printStmt (void);
 EXTERN void m2misc_DebugTreeChain (tree t);
 EXTERN void m2misc_cerror (const char *message);
 EXTERN void m2misc_error (const char *message);
+EXTERN void m2misc_warning_m2_dump_filter (const char *message, const char *rule);
 
 #undef EXTERN
 #endif /* m2misc_h.  */
diff --git a/gcc/m2/gm2-gcc/m2pp.cc b/gcc/m2/gm2-gcc/m2pp.cc
index ce004b7..acff6cf 100644
--- a/gcc/m2/gm2-gcc/m2pp.cc
+++ b/gcc/m2/gm2-gcc/m2pp.cc
@@ -35,6 +35,12 @@ along with GNU Modula-2; see the file COPYING3.  If not see
 #include "m2pp.h"
 
 #define GM2
+/* VERBOSE_TYPE_DESC enables type descriptions to be generated in the
+   assignment and during variable declarations.  It generates
+   moderately ugly output, although the assignment type information
+   can be useful when tracking down non gimple complient trees (during
+   assignment).  */
+#undef VERBOSE_TYPE_DESC
 
 const char *m2pp_dump_description[M2PP_DUMP_END] =
 {
@@ -898,6 +904,7 @@ m2pp_identifier (pretty *s, tree t)
           else
             snprintf (name, 100, "D_%u", DECL_UID (t));
           m2pp_print (s, name);
+#ifdef VERBOSE_TYPE_DESC
 	  if (TREE_TYPE (t) != NULL_TREE)
 	    {
 	      m2pp_needspace (s);
@@ -905,12 +912,11 @@ m2pp_identifier (pretty *s, tree t)
 	      m2pp_needspace (s);
 	      m2pp_simple_type (s, TREE_TYPE (t));
 	      m2pp_needspace (s);
-#if 0
 	      m2pp_type_lowlevel (s, TREE_TYPE (t));
 	      m2pp_needspace (s);
-#endif
 	      m2pp_print (s, "*)");
 	    }
+#endif
         }
     }
 }
@@ -1842,11 +1848,13 @@ m2pp_constructor (pretty *s, tree t)
     m2pp_print (s, ", ");
   }
   m2pp_print (s, "}");
+#ifdef VERBOSE_TYPE_DESC
   m2pp_print (s, "(* type: ");
   setindent (s, getindent (s) + 8);
   m2pp_type (s, TREE_TYPE (t));
   setindent (s, getindent (s) - 8);
   m2pp_print (s, " *)\n");
+#endif
 }
 
 /* m2pp_complex_expr handle GCC complex_expr tree.  */
@@ -2569,15 +2577,20 @@ m2pp_assignment (pretty *s, tree t)
   int o;
 
   m2pp_begin (s);
-
+#ifdef VERBOSE_TYPE_DESC
   /* Print the types of des and expr.  */
+  m2pp_print (s, "(*");
+  m2pp_needspace (s);
   m2pp_type (s, TREE_TYPE (TREE_OPERAND (t, 0)));
   m2pp_needspace (s);
   m2pp_print (s, ":=");
   m2pp_needspace (s);
   m2pp_type (s, TREE_TYPE (TREE_OPERAND (t, 1)));
   m2pp_needspace (s);
-  m2pp_print (s, ";\n");
+  m2pp_print (s, ";");
+  m2pp_needspace (s);
+  m2pp_print (s, "*)\n");
+#endif
   /* Print the assignment statement.  */
   m2pp_designator (s, TREE_OPERAND (t, 0));
   m2pp_needspace (s);
diff --git a/gcc/m2/gm2-lang.cc b/gcc/m2/gm2-lang.cc
index e31a6c4..b3c3c01 100644
--- a/gcc/m2/gm2-lang.cc
+++ b/gcc/m2/gm2-lang.cc
@@ -42,8 +42,6 @@ Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
 #include "convert.h"
 #include "rtegraph.h"
 
-#undef ENABLE_M2DUMP_ALL
-
 static void write_globals (void);
 
 static int insideCppArgs = FALSE;
@@ -521,7 +519,6 @@ gm2_langhook_handle_option (
     case OPT_fm2_debug_trace_:
       M2Options_SetM2DebugTraceFilter (value, arg);
       return 1;
-#ifdef ENABLE_M2DUMP_ALL
     case OPT_fm2_dump_:
       return M2Options_SetM2Dump (value, arg);
     case OPT_fm2_dump_decl_:
@@ -536,7 +533,6 @@ gm2_langhook_handle_option (
     case OPT_fm2_dump_filter_:
       M2Options_SetM2DumpFilter (value, arg);
       return 1;
-#endif
     case OPT_Wall:
       M2Options_SetWall (value);
       return 1;
diff --git a/gcc/m2/lang.opt b/gcc/m2/lang.opt
index 1c16531..3fc84a1 100644
--- a/gcc/m2/lang.opt
+++ b/gcc/m2/lang.opt
@@ -134,6 +134,26 @@ fm2-debug-trace=
 Modula-2 Joined
 turn on internal debug tracing for quad,token,line,all (internal switch)
 
+fm2-dump=
+Modula-2 Joined
+dump Modula-2 internal intemediate representation specified by: all,quad,decl,gimple
+
+fm2-dump-decl=
+Modula-2 Joined
+dump Modula-2 decls to the filename stem specified
+
+fm2-dump-gimple=
+Modula-2 Joined
+dump Modula-2 gimple to the filename stem specified
+
+fm2-dump-quad=
+Modula-2 Joined
+dump Modula-2 quads to the filename stem specified
+
+fm2-dump-filter=
+Modula-2 Joined
+filter the language dump using a comma separated list of procedures and modules
+
 fm2-g
 Modula-2
 generate extra nops to improve debugging, producing an instruction for every code related keyword