PR modula2/114565 progress trace would be useful to isolate ICE for u…

…sers

This patch introduces the internal option -fm2-debug-trace= which can
be given a comma separated list of filter terms.  Currently it allows:
all,line,token,quad.  The patch allows users to trace the progress of
cc1gm2 so that source which causes an ICE can be reduced.  Once
PR113836 is complete it is expected that the trace information will be
written to file.

gcc/m2/ChangeLog:

	PR modula2/114565
	* gm2-compiler/M2GenGCC.mod (CodeStatement): Test
	GetDebugTraceQuad before calling DisplayQuad.
	* gm2-compiler/M2LexBuf.mod (NumberIO): Import CardToStr.
	(GetToken): Test GetDebugTraceToken before writing the
	token number or token line.
	* gm2-compiler/M2Options.def (SetDebugTraceQuad): Rename to
	(SetM2DebugTraceFilter): ...this.
	(SetDebugTraceAPI): Remove.
	(GetDebugTraceQuad): New procedure function.
	(GetDebugTraceTree): Ditto.
	(GetDebugTraceToken): Ditto.
	(GetDebugTraceLine): Ditto.
	(GetDebugFunctionLineNumbers): Ditto.
	* gm2-compiler/M2Options.mod (DebugFunctionLineNumbers): New
	boolean variable.
	(DebugTraceQuad): Ditto.
	(DebugTraceTree): Ditto.
	(DebugTraceLine): Ditto.
	(DebugTraceToken): Ditto.
	(errors1): New procedure.
	(SetDebugTraceQuad): Remove.
	(SetM2DebugTraceFilter): New procedure implemented.
	(SetM2DebugTrace): Ditto.
	(GetDebugTraceQuad): Ditto.
	(GetDebugTraceToken ): Ditto.
	(GetDebugTraceLine): Ditto.
	(SetDebugTraceLine): Remove.
	* gm2-compiler/M2Quads.mod (GenQuadOTrash): Test
	GetDebugTraceQuad and call DisplayQuad.
	(GenQuadOTypetok): Ditto.
	* gm2-compiler/SymbolTable.mod: Replace
	DebugFunctionLineNumbers with GetDebugFunctionLineNumbers.
	* gm2-gcc/init.cc (_M2_M2LangDump_init): Add prototype.
	(init_PerCompilationInit): Add call.
	* gm2-gcc/m2misc.cc (m2misc_cerror): New function.
	(m2misc_error): Ditto.
	* gm2-gcc/m2misc.def (error): New procedure.
	(cerror): Ditto.
	* gm2-gcc/m2misc.h (m2misc_cerror): New prototype.
	(m2misc_error): Ditto.
	* gm2-gcc/m2options.h (M2Options_SetDebugTraceQuad): New
	prototype.
	(M2Options_SetDebugTraceAPI): Remove.
	(M2Options_GetDebugTraceToken): New prototype.
	(M2Options_GetDebugTraceLine): Ditto.
	(M2Options_SetDebugFunctionLineNumbers): Ditto.
	(M2Options_GetDebugFunctionLineNumbers): Ditto.
	(M2Options_SetM2DebugTraceFilter): Ditto.
	* gm2-lang.cc (gm2_langhook_init_options): Remove
	OPT_fdebug_trace_quad case.
	Remove OPT_fdebug_trace_api case.
	Add OPT_fm2_debug_trace_ case.
	* lang.opt (fm2-debug-trace): New option.
	(fdebug-trace-api): Remove.
	(fdebug-trace-quad): Remove.
	* m2.flex (m2flex_M2Error): Check s for NULL.
	(skipnewline): New function.
	(consumeLine): Call traceline.

Signed-off-by: Gaius Mulley <[email protected]>

gcc/m2/gm2-compiler/M2GenGCC.mod

@@ -96,8 +96,7 @@ FROM M2MetaError IMPORT MetaErrorT0, MetaErrorT1, MetaErrorT2, MetaErrorT3,
 FROM M2Options IMPORT UnboundedByReference, PedanticCast,
                       VerboseUnbounded, Iso, Pim, DebugBuiltins, WholeProgram,
                       StrictTypeChecking, AutoInit, cflag, ScaffoldMain,
-                      ScaffoldDynamic, ScaffoldStatic,
-                      DebugTraceQuad, DebugTraceAPI ;
+                      ScaffoldDynamic, ScaffoldStatic, GetDebugTraceQuad ;
 
 FROM M2Printf IMPORT printf0, printf1, printf2, printf4 ;
 FROM M2Quiet IMPORT qprintf0 ;
@@ -459,7 +458,7 @@ BEGIN
    END ;
    location := TokenToLocation (CurrentQuadToken) ;
    CheckReferenced(q, op) ;
-   IF DebugTraceQuad
+   IF GetDebugTraceQuad ()
    THEN
       printf0('building: ') ;
       DisplayQuad(q)

gcc/m2/gm2-compiler/M2LexBuf.mod

@@ -22,9 +22,10 @@ along with GNU Modula-2; see the file COPYING3.  If not see
 IMPLEMENTATION MODULE M2LexBuf ;
 
 IMPORT m2flex ;
+IMPORT FIO ;
 
 FROM libc IMPORT strlen ;
-FROM SYSTEM IMPORT ADDRESS ;
+FROM SYSTEM IMPORT ADDRESS, ADR ;
 FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
 FROM DynamicStrings IMPORT string, InitString, InitStringCharStar, Equal, Mark, KillString ;
 FROM FormatStrings IMPORT Sprintf1 ;
@@ -33,10 +34,13 @@ FROM M2Reserved IMPORT toktype, tokToTok ;
 FROM M2Printf IMPORT printf0, printf1, printf2, printf3 ;
 FROM M2Debug IMPORT Assert ;
 FROM NameKey IMPORT makekey ;
+FROM NumberIO IMPORT CardToStr ;
 FROM m2linemap IMPORT location_t, GetLocationBinary ;
 FROM M2Emit IMPORT UnknownLocation, BuiltinsLocation ;
 FROM M2Error IMPORT WarnStringAt ;
 FROM M2MetaError IMPORT MetaErrorT0 ;
+FROM M2Options IMPORT GetDebugTraceToken ;
+FROM M2LangDump IMPORT GetDumpFile ;
 
 FROM Indexing IMPORT Index, InitIndex, GetIndice, PutIndice,
                      KillIndex, ForeachIndiceInIndexDo,
@@ -659,16 +663,30 @@ END GetTokenFiltered ;
 *)
 
 PROCEDURE GetToken ;
+VAR
+   buf: ARRAY [0..20] OF CHAR ;
 BEGIN
    IF UseBufferedTokens
    THEN
-      UpdateToken (ListOfTokens, CurrentTokNo)
+      UpdateToken (ListOfTokens, CurrentTokNo) ;
+      IF GetDebugTraceToken ()
+      THEN
+         CardToStr (CurrentTokNo, 0, buf) ;
+         FIO.WriteString (GetDumpFile (), 'token: ') ;
+         FIO.WriteString (GetDumpFile (), buf) ;
+         FIO.WriteLine (GetDumpFile ())
+      END
    ELSE
       IF NOT InBounds (ListOfTokens, CurrentTokNo)
       THEN
          GetTokenFiltered (FALSE)
       END ;
-      UpdateToken (ListOfTokens, CurrentTokNo)
+      UpdateToken (ListOfTokens, CurrentTokNo) ;
+      IF GetDebugTraceToken ()
+      THEN
+         CardToStr (CurrentTokNo, 0, buf) ;
+         m2flex.M2Error (ADR (buf))
+      END
    END
 END GetToken ;
 

gcc/m2/gm2-compiler/M2Options.def

@@ -45,8 +45,6 @@ VAR
    Pim4,                         (* -fpim4 use strict rules.                 *)
    PositiveModFloorDiv,          (* Force PIM4 behaviour for DIV and MOD     *)
    CompilerDebugging,            (* -fd internal debugging messages          *)
-   DebugTraceQuad,               (* -fdebug-trace-quad                       *)
-   DebugTraceAPI,                (* -fdebug-trace-api                        *)
    GenerateDebugging,            (* -g option to generate info for gdb/dbx   *)
    GenerateLineDebug,            (* -gline to generate line debugging.       *)
    Verbose,                      (* -verbose produce verbose error messages. *)
@@ -119,7 +117,6 @@ VAR
                                  (* the shared library version of the        *)
                                  (* scaffold.                                *)
    ForcedLocation,
-   DebugFunctionLineNumbers,
    GenerateStatementNote,
    Optimizing,
    Coding,
@@ -672,22 +669,16 @@ PROCEDURE SetQuadDebugging (value: BOOLEAN) ;
 
 
 (*
-   SetDebugTraceQuad -
+   SetM2DebugTraceFilter - set internal debug flags.  The flags should be
+                           specified as a comma separated list.  The full
+                           list allowed is quad,line,token,tree.
 *)
 
-PROCEDURE SetDebugTraceQuad (value: BOOLEAN) ;
+PROCEDURE SetM2DebugTraceFilter (value: BOOLEAN; filter: ADDRESS) ;
 
 
 (*
-   SetDebugTraceAPI -
-*)
-
-PROCEDURE SetDebugTraceAPI (value: BOOLEAN) ;
-
-
-(*
-   SetDebugFunctionLineNumbers - turn DebugFunctionLineNumbers on/off
-                                 (used internally for debugging).
+   SetDebugFunctionLineNumbers - set DebugFunctionLineNumbers.
 *)
 
 PROCEDURE SetDebugFunctionLineNumbers (value: BOOLEAN) ;
@@ -1076,6 +1067,41 @@ PROCEDURE GetM2DumpFilter () : ADDRESS ;
 PROCEDURE GetDumpLangGimple () : BOOLEAN ;
 
 
+(*
+   GetDebugTraceQuad - return DebugTraceQuad.
+*)
+
+PROCEDURE GetDebugTraceQuad () : BOOLEAN ;
+
+
+(*
+   GetDebugTraceTree - return DebugTraceTree.
+*)
+
+PROCEDURE GetDebugTraceTree () : BOOLEAN ;
+
+
+(*
+   GetDebugTraceToken - return DebugTraceToken.
+*)
+
+PROCEDURE GetDebugTraceToken () : BOOLEAN ;
+
+
+(*
+   GetDebugTraceLine - return DebugTraceLine.
+*)
+
+PROCEDURE GetDebugTraceLine () : BOOLEAN ;
+
+
+(*
+   GetDebugFunctionLineNumbers - return DebugFunctionLineNumbers.
+*)
+
+PROCEDURE GetDebugFunctionLineNumbers () : BOOLEAN ;
+
+
 (*
    FinaliseOptions - once all options have been parsed we set any inferred
                      values.

gcc/m2/gm2-compiler/M2Options.mod

@@ -33,10 +33,12 @@ FROM Debug IMPORT Halt ;
 FROM m2linemap IMPORT location_t ;
 FROM m2configure IMPORT FullPathCPP, TargetIEEEQuadDefault ;
 FROM M2Error IMPORT InternalError ;
+FROM FormatStrings IMPORT Sprintf1 ;
+FROM m2misc IMPORT cerror ;
 
 FROM DynamicStrings IMPORT String, Length, InitString, Mark, Slice, EqualArray,
                            InitStringCharStar, ConCatChar, ConCat, KillString,
-                           Dup, string, char,
+                           Dup, string, char, Index,
                            PushAllocation, PopAllocationExemption,
                            InitStringDB, InitStringCharStarDB,
                            InitStringCharDB, MultDB, DupDB, SliceDB ;
@@ -73,6 +75,11 @@ VAR
    UselistFilename,
    RuntimeModuleOverride,
    CppArgs              : String ;
+   DebugFunctionLineNumbers,
+   DebugTraceQuad,   (* -fdebug-trace-quad.  *)
+   DebugTraceTree,   (* -fdebug-trace-tree.  *)
+   DebugTraceLine,   (* -fdebug-trace-line.  *)
+   DebugTraceToken, (* -fdebug-trace-token.  *)
    MFlag,
    MMFlag,
    MPFlag,
@@ -317,6 +324,22 @@ BEGIN
 END GetMP ;
 
 
+(*
+   errors1 -
+*)
+
+PROCEDURE errors1 (format: ARRAY OF CHAR; arg: String) ;
+VAR
+   message: String ;
+   cstr   : ADDRESS ;
+BEGIN
+   message := Sprintf1 (InitString (format), arg) ;
+   cstr := string (message) ;
+   cerror (cstr) ;
+   exit (1)
+END errors1 ;
+
+
 (*
    AddWord - concats a word to sentence inserting a space if necessary.
              sentence is returned.  sentence will be created if it is NIL.
@@ -1079,23 +1102,121 @@ END SetCompilerDebugging ;
 
 
 (*
-   SetDebugTraceQuad -
+   SetM2DebugTraceFilter - set internal debug flags.  The flags should be
+                           specified as a comma separated list.  The full
+                           list allowed is quad,line,token,all.
+*)
+
+PROCEDURE SetM2DebugTraceFilter (value: BOOLEAN; filter: ADDRESS) ;
+VAR
+   word,
+   full  : String ;
+   start,
+   i     : INTEGER ;
+BEGIN
+   full := InitStringCharStar (filter) ;
+   start := 0 ;
+   REPEAT
+      i := Index (full, ',', start) ;
+      IF i = -1
+      THEN
+         word := Slice (full, start, 0)
+      ELSE
+         word := Slice (full, start, i)
+      END ;
+      SetM2DebugTrace (word, value) ;
+      word := KillString (word) ;
+      start := i+1 ;
+   UNTIL i = -1 ;
+   full := KillString (full) ;
+END SetM2DebugTraceFilter ;
+
+
+(*
+   SetM2DebugTrace -
+*)
+
+PROCEDURE SetM2DebugTrace (word: String; value: BOOLEAN) ;
+BEGIN
+   IF EqualArray (word, 'all')
+   THEN
+      (* DebugTraceTree := value *)
+      DebugTraceQuad := value ;
+      DebugTraceToken := value ;
+      DebugTraceLine := value
+   ELSIF EqualArray (word, 'quad')
+   THEN
+      DebugTraceQuad := value
+   ELSIF EqualArray (word, 'token')
+   THEN
+      DebugTraceToken := value
+   ELSIF EqualArray (word, 'line')
+   THEN
+      DebugTraceLine := value
+   ELSE
+      errors1 ("unrecognized filter %s seen in -fm2-debug-trace= option\n", word)
+   END
+END SetM2DebugTrace ;
+
+
+(*
+   SetDebugFunctionLineNumbers - set DebugFunctionLineNumbers.
+*)
+
+PROCEDURE SetDebugFunctionLineNumbers (value: BOOLEAN) ;
+BEGIN
+   DebugFunctionLineNumbers := value
+END SetDebugFunctionLineNumbers ;
+
+
+(*
+   GetDebugTraceQuad - return DebugTraceQuad.
+*)
+
+PROCEDURE GetDebugTraceQuad () : BOOLEAN ;
+BEGIN
+   RETURN DebugTraceQuad
+END GetDebugTraceQuad ;
+
+
+(*
+   GetDebugTraceTree - return DebugTraceTree.
+*)
+
+PROCEDURE GetDebugTraceTree () : BOOLEAN ;
+BEGIN
+   RETURN DebugTraceTree
+END GetDebugTraceTree ;
+
+
+(*
+   GetDebugTraceToken - return DebugTraceToken.
+*)
+
+PROCEDURE GetDebugTraceToken () : BOOLEAN ;
+BEGIN
+   RETURN DebugTraceToken
+END GetDebugTraceToken ;
+
+
+(*
+   GetDebugTraceLine - return DebugTraceLine.
 *)
 
-PROCEDURE SetDebugTraceQuad (value: BOOLEAN) ;
+PROCEDURE GetDebugTraceLine () : BOOLEAN ;
 BEGIN
-   DebugTraceQuad := value
-END SetDebugTraceQuad ;
+   RETURN DebugTraceLine
+END GetDebugTraceLine ;
 
 
 (*
-   SetDebugTraceAPI -
+   GetDebugFunctionLineNumbers - return DebugFunctionLineNumbers.
 *)
 
-PROCEDURE SetDebugTraceAPI (value: BOOLEAN) ;
+PROCEDURE GetDebugFunctionLineNumbers () : BOOLEAN ;
 BEGIN
-   DebugTraceAPI := value
-END SetDebugTraceAPI ;
+   RETURN DebugFunctionLineNumbers
+END GetDebugFunctionLineNumbers ;
 
 
 (*
@@ -1236,17 +1357,6 @@ BEGIN
 END OverrideLocation ;
 
 
-(*
-   SetDebugFunctionLineNumbers - turn DebugFunctionLineNumbers on/off
-                                 (used internally for debugging).
-*)
-
-PROCEDURE SetDebugFunctionLineNumbers (value: BOOLEAN) ;
-BEGIN
-   DebugFunctionLineNumbers := value
-END SetDebugFunctionLineNumbers ;
-
-
 (*
    SetGenerateStatementNote - turn on generation of nops if necessary
                               to generate pedalogical single stepping.
@@ -1848,7 +1958,9 @@ BEGIN
    ForcedLocation                    := FALSE ;
    WholeProgram                      := FALSE ;
    DebugTraceQuad                    := FALSE ;
-   DebugTraceAPI                     := FALSE ;
+   DebugTraceTree                    := FALSE ;
+   DebugTraceLine                    := FALSE ;
+   DebugTraceToken                   := FALSE ;
    DebugFunctionLineNumbers          := FALSE ;
    GenerateStatementNote             := FALSE ;
    LowerCaseKeywords                 := FALSE ;