[gcc r15-110] PR modula2/113836 gm2 does not dump gimple or quadruples to a file

[gcc r15-110] PR modula2/113836 gm2 does not dump gimple or quadruples to a file

[Gaius Mulley]

https://gcc.gnu.org/g:43dc4302b4181535d24e83759514b774ae4dbfcc

commit r15-110-g43dc4302b4181535d24e83759514b774ae4dbfcc
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date:   Thu May 2 13:16:07 2024 +0100

    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>

Diff:
---
 gcc/doc/gm2.texi                   |  39 ++++++++--
 gcc/m2/gm2-compiler/M2AsmUtil.def  |   2 -
 gcc/m2/gm2-compiler/M2LangDump.mod | 150 +++++++++++++++++++++++++++++++++++--
 gcc/m2/gm2-gcc/m2misc.cc           |  10 +++
 gcc/m2/gm2-gcc/m2misc.def          |   3 +-
 gcc/m2/gm2-gcc/m2misc.h            |   1 +
 gcc/m2/gm2-gcc/m2pp.cc             |  21 +++++-
 gcc/m2/gm2-lang.cc                 |   4 -
 gcc/m2/lang.opt                    |  20 +++++
 9 files changed, 225 insertions(+), 25 deletions(-)

diff --git a/gcc/doc/gm2.texi b/gcc/doc/gm2.texi
index 19b864573c1..b38d6a15de0 100644
--- a/gcc/doc/gm2.texi
+++ b/gcc/doc/gm2.texi
@@ -466,10 +466,39 @@ this option forces the use of the static version.
 @c Modula-2 Joined
 @c set all location values to a specific value (internal switch)
 
-@c fm2-debug-trace=
-@c Modula-2 Joined
-@c turn on trace debugging using a comma separated list:
-@c line,token,quad,all.
+@item -fm2-debug-trace=
+turn on trace debugging using a comma separated list:
+@samp{line,token,quad,all}.  This is an internal command line option.
+
+@item -fm2-dump=
+enable dumping of modula-2 internal representation of data structures
+using a comma separated list.  The list can contain:
+@samp{quad,gimple,decl,all}.
+
+@item -fm2-dump-decl=@file{filestem}
+dump the modula-2 representation of a symbol to the @file{filestem}
+specified.  This option only takes effect if the
+@samp{-fm2-dump-filter} is specified.
+
+@item -fm2-dump-gimple=@file{filestem}
+dump modula-2 gimple representation to the @file{filestem} specified.
+
+@item -fm2-dump-quad=@file{filestem}
+dump quadruple representation to the @file{filestem} specified.
+
+@item -fm2-dump-filter=@samp{rules}
+filter the language dumps @samp{-fdump-lang-decl},
+@samp{-fdump-lang-gimple} and@samp{-fdump-lang-quad}
+on @samp{rules}.  @samp{rules} must be a comma
+separated list which can take three forms: the full decl textual name
+of a procedure, @samp{[libname.]module.ident} or
+@samp{[filename:]module.ident}.  This is an internal command line
+option.  Currently it only filters on procedure names and regexp
+matching is not implemented.  Three examples of its use following
+the previous forms could be:
+@code{-fm2-dump-filter=_M2_hello_init},
+@code{-fm2-dump-filter=m2pim.StrIO.WriteString} and
+@code{-fm2-dump-filter=StrLib.mod:StrIO.WriteString}.
 
 @item -fm2-g
 improve the debugging experience for new programmers at the expense
@@ -487,7 +516,7 @@ specify the module mangled prefix name for all modules in the
 following include paths.
 
 @item -fm2-pathnameI
-for internal use only: used by the driver to copy the user facing -I
+for internal use only: used by the driver to copy the user facing @samp{-I}
 option.
 
 @item -fm2-plugin
diff --git a/gcc/m2/gm2-compiler/M2AsmUtil.def b/gcc/m2/gm2-compiler/M2AsmUtil.def
index c23992e7811..9077c45b582 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 ec3522b62dd..e65f5b040a5 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 ;
@@ -227,18 +246,133 @@ BEGIN
 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 df77f32b58d..1d337ffcb2f 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 26b0e4448f3..77fd2833f64 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 f0aa82e2eed..22139841ed0 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 ce004b771a6..acff6cf2e21 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 e31a6c437ec..b3c3c017cc9 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 1c165317959..3fc84a12d94 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