https://gcc.gnu.org/g:1bafa6a3fdbb53651ffa5d854c2341c487bf3269
commit r14-9764-g1bafa6a3fdbb53651ffa5d854c2341c487bf3269
Author: Gaius Mulley <gaiusm...@gmail.com>
Date: Tue Apr 2 23:47:42 2024 +0100
PR modula2/114565 progress trace would be useful to isolate ICE for users
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 <gaiusm...@gmail.com>
Diff:
---
gcc/m2/gm2-compiler/M2GenGCC.mod | 5 +-
gcc/m2/gm2-compiler/M2LexBuf.mod | 24 +++++-
gcc/m2/gm2-compiler/M2Options.def | 54 +++++++++----
gcc/m2/gm2-compiler/M2Options.mod | 154 +++++++++++++++++++++++++++++++-----
gcc/m2/gm2-compiler/M2Quads.mod | 18 ++++-
gcc/m2/gm2-compiler/SymbolTable.mod | 6 +-
gcc/m2/gm2-gcc/init.cc | 2 +
gcc/m2/gm2-gcc/m2misc.cc | 16 ++++
gcc/m2/gm2-gcc/m2misc.def | 4 +
gcc/m2/gm2-gcc/m2misc.h | 2 +
gcc/m2/gm2-gcc/m2options.h | 7 +-
gcc/m2/gm2-lang.cc | 9 +--
gcc/m2/lang.opt | 14 ++--
gcc/m2/m2.flex | 35 +++++++-
14 files changed, 285 insertions(+), 65 deletions(-)
diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod
index 7e27373a6ac..60f58cc2d1b 100644
--- a/gcc/m2/gm2-compiler/M2GenGCC.mod
+++ b/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)
diff --git a/gcc/m2/gm2-compiler/M2LexBuf.mod b/gcc/m2/gm2-compiler/M2LexBuf.mod
index df073630bc1..fd2373fa501 100644
--- a/gcc/m2/gm2-compiler/M2LexBuf.mod
+++ b/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 ;
diff --git a/gcc/m2/gm2-compiler/M2Options.def
b/gcc/m2/gm2-compiler/M2Options.def
index e4ebf41802f..50504d088b6 100644
--- a/gcc/m2/gm2-compiler/M2Options.def
+++ b/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.
diff --git a/gcc/m2/gm2-compiler/M2Options.mod
b/gcc/m2/gm2-compiler/M2Options.mod
index b0de8cdfe82..09d62cbc732 100644
--- a/gcc/m2/gm2-compiler/M2Options.mod
+++ b/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 ;
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index f2dfc8390ac..12bc5494996 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -221,7 +221,7 @@ FROM M2Options IMPORT NilChecking,
ScaffoldDynamic, ScaffoldStatic, cflag,
ScaffoldMain, SharedFlag, WholeProgram,
GetDumpDir, GetM2DumpFilter,
- GetRuntimeModuleOverride,
+ GetRuntimeModuleOverride, GetDebugTraceQuad,
DumpLangQuad ;
FROM M2LangDump IMPORT CreateDumpQuad, CloseDumpQuad, GetDumpFile ;
@@ -13390,13 +13390,18 @@ BEGIN
TokenNo := GetTokenNo ()
ELSE
TokenNo := TokPos
+ END ;
+ IF GetDebugTraceQuad ()
+ THEN
+ printf0('generating: ') ;
+ DisplayQuad (NextQuad) ;
+ (* MetaErrorT1 (TokenNo, '{%1On}', NextQuad) *)
END
END ;
IF NextQuad=BreakAtQuad
THEN
stop
END ;
- (* DisplayQuad(NextQuad) ; *)
NewQuad (NextQuad)
END
END GenQuadOTrash ;
@@ -13475,13 +13480,18 @@ BEGIN
END ;
op1pos := Op1Pos ;
op2pos := Op2Pos ;
- op3pos := Op3Pos
+ op3pos := Op3Pos ;
+ IF GetDebugTraceQuad ()
+ THEN
+ printf0('generating: ') ;
+ DisplayQuad (NextQuad) ;
+ (* MetaErrorT1 (TokenNo, '{%1On}', NextQuad) *)
+ END
END ;
IF NextQuad=BreakAtQuad
THEN
stop
END ;
- (* DisplayQuad(NextQuad) ; *)
NewQuad (NextQuad)
END
END GenQuadOTypetok ;
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod
b/gcc/m2/gm2-compiler/SymbolTable.mod
index 9d572cff19c..fc1cb74c866 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -35,7 +35,9 @@ FROM Indexing IMPORT InitIndex, InBounds, LowIndice,
HighIndice,
FROM Sets IMPORT Set, InitSet, IncludeElementIntoSet, IsElementInSet ;
FROM m2linemap IMPORT location_t ;
-FROM M2Options IMPORT Pedantic, ExtendedOpaque, DebugFunctionLineNumbers,
ScaffoldDynamic, DebugBuiltins ;
+FROM M2Options IMPORT Pedantic, ExtendedOpaque,
+ GetDebugFunctionLineNumbers, ScaffoldDynamic,
+ DebugBuiltins ;
FROM M2LexBuf IMPORT UnknownTokenNo, TokenToLineNo,
FindFileNameFromToken, TokenToLocation ;
@@ -1375,7 +1377,7 @@ END DebugProcedureLineNumber ;
PROCEDURE DebugLineNumbers (sym: CARDINAL) ;
BEGIN
- IF DebugFunctionLineNumbers
+ IF GetDebugFunctionLineNumbers ()
THEN
printf0 ('<lines>\n') ;
ForeachProcedureDo(sym, DebugProcedureLineNumber) ;
diff --git a/gcc/m2/gm2-gcc/init.cc b/gcc/m2/gm2-gcc/init.cc
index 479e06f9097..17ca9189f10 100644
--- a/gcc/m2/gm2-gcc/init.cc
+++ b/gcc/m2/gm2-gcc/init.cc
@@ -78,6 +78,7 @@ EXTERN void _M2_SymbolKey_init (int argc, char *argv[], char
*envp[]);
EXTERN void _M2_FifoQueue_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_M2Reserved_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_M2Const_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_M2LangDump_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_P1SymBuild_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_P2SymBuild_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_P3SymBuild_init (int argc, char *argv[], char *envp[]);
@@ -198,5 +199,6 @@ init_PerCompilationInit (const char *filename)
_M2_M2SSA_init (0, NULL, NULL);
_M2_M2SymInit_init (0, NULL, NULL);
_M2_M2Check_init (0, NULL, NULL);
+ _M2_M2LangDump_init (0, NULL, NULL);
M2Comp_compile (filename);
}
diff --git a/gcc/m2/gm2-gcc/m2misc.cc b/gcc/m2/gm2-gcc/m2misc.cc
index 451abfe14f9..df77f32b58d 100644
--- a/gcc/m2/gm2-gcc/m2misc.cc
+++ b/gcc/m2/gm2-gcc/m2misc.cc
@@ -29,6 +29,22 @@ along with GNU Modula-2; see the file COPYING3. If not see
#include "m2misc.h"
#include "m2tree.h"
+/* C error entry to error. */
+
+void
+m2misc_cerror (const char *message)
+{
+ error (message);
+}
+
+/* modula2 entry for cerror. */
+
+void
+m2misc_error (const char *message)
+{
+ m2misc_cerror (message);
+}
+
/* DebugTree - display the tree t. */
void
diff --git a/gcc/m2/gm2-gcc/m2misc.def b/gcc/m2/gm2-gcc/m2misc.def
index 41b8751e635..26b0e4448f3 100644
--- a/gcc/m2/gm2-gcc/m2misc.def
+++ b/gcc/m2/gm2-gcc/m2misc.def
@@ -22,8 +22,12 @@ along with GNU Modula-2; see the file COPYING3. If not see
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) ;
END m2misc.
diff --git a/gcc/m2/gm2-gcc/m2misc.h b/gcc/m2/gm2-gcc/m2misc.h
index 8fe08c7b8a4..f0aa82e2eed 100644
--- a/gcc/m2/gm2-gcc/m2misc.h
+++ b/gcc/m2/gm2-gcc/m2misc.h
@@ -39,6 +39,8 @@ along with GNU Modula-2; see the file COPYING3. If not see
EXTERN void m2misc_DebugTree (tree t);
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);
#undef EXTERN
#endif /* m2misc_h. */
diff --git a/gcc/m2/gm2-gcc/m2options.h b/gcc/m2/gm2-gcc/m2options.h
index 4b3a23f18db..363b2605e9e 100644
--- a/gcc/m2/gm2-gcc/m2options.h
+++ b/gcc/m2/gm2-gcc/m2options.h
@@ -84,8 +84,10 @@ EXTERN bool M2Options_SetVerboseUnbounded (bool value);
EXTERN void M2Options_SetXCode (bool value);
EXTERN void M2Options_SetCompilerDebugging (bool value);
EXTERN void M2Options_SetQuadDebugging (bool value);
-EXTERN void M2Options_SetDebugTraceQuad (bool value);
-EXTERN void M2Options_SetDebugTraceAPI (bool value);
+EXTERN bool M2Options_GetDebugTraceToken (void);
+EXTERN bool M2Options_GetDebugTraceLine (void);
+EXTERN void M2Options_SetDebugFunctionLineNumbers (bool value);
+EXTERN bool M2Options_GetDebugFunctionLineNumbers (void);
EXTERN void M2Options_SetSources (bool value);
EXTERN bool M2Options_SetUnboundedByReference (bool value);
EXTERN void M2Options_SetDumpSystemExports (bool value);
@@ -162,6 +164,7 @@ EXTERN void M2Options_SetDumpLangGimpleFilename (bool
value, const char *arg);
EXTERN bool M2Options_GetDumpLangGimple (void);
EXTERN void M2Options_SetM2DumpFilter (bool value, const char *args);
EXTERN char *M2Options_GetM2DumpFilter (void);
+EXTERN void M2Options_SetM2DebugTraceFilter (bool value, const char *arg);
#undef EXTERN
#endif /* m2options_h. */
diff --git a/gcc/m2/gm2-lang.cc b/gcc/m2/gm2-lang.cc
index fc70fbb50bf..f7ab8b807d3 100644
--- a/gcc/m2/gm2-lang.cc
+++ b/gcc/m2/gm2-lang.cc
@@ -475,12 +475,6 @@ gm2_langhook_handle_option (
case OPT_fdebug_builtins:
M2Options_SetDebugBuiltins (value);
return 1;
- case OPT_fdebug_trace_quad:
- M2Options_SetDebugTraceQuad (value);
- return 1;
- case OPT_fdebug_trace_api:
- M2Options_SetDebugTraceAPI (value);
- return 1;
case OPT_fdebug_function_line_numbers:
M2Options_SetDebugFunctionLineNumbers (value);
return 1;
@@ -549,6 +543,9 @@ gm2_langhook_handle_option (
case OPT_fm2_strict_type:
M2Options_SetStrictTypeChecking (value);
return 1;
+ case OPT_fm2_debug_trace_:
+ M2Options_SetM2DebugTraceFilter (value, arg);
+ return 1;
#ifdef ENABLE_QUAD_DUMP_ALL
case OPT_fm2_dump_filter_:
M2Options_SetM2DumpFilter (value, arg);
diff --git a/gcc/m2/lang.opt b/gcc/m2/lang.opt
index 505f4b56e8a..206bd03d09f 100644
--- a/gcc/m2/lang.opt
+++ b/gcc/m2/lang.opt
@@ -90,17 +90,9 @@ fd
Modula-2
turn on internal debugging of the compiler (internal switch)
-fdebug-trace-quad
-Modula-2
-turn on quadruple tracing (internal switch)
-
-fdebug-trace-api
-Modula-2
-turn on the Modula-2 api tracing (internal switch)
-
fdebug-function-line-numbers
Modula-2
-turn on the Modula-2 function line number generation (internal switch)
+turn on tracing of procedure line numbers (internal switch)
fdef=
Modula-2 Joined
@@ -138,6 +130,10 @@ flocation=
Modula-2 Joined
set all location values to a specific value (internal switch)
+fm2-debug-trace=
+Modula-2 Joined
+turn on internal debug tracing for quad,token,line,all (internal switch)
+
fm2-g
Modula-2
generate extra nops to improve debugging, producing an instruction for every
code related keyword
diff --git a/gcc/m2/m2.flex b/gcc/m2/m2.flex
index d874db9dae2..2483b282d48 100644
--- a/gcc/m2/m2.flex
+++ b/gcc/m2/m2.flex
@@ -491,7 +491,10 @@ EXTERN void m2flex_M2Error (const char *s)
}
putchar('\n');
}
- printf("%s:%d:%s\n", filename, currentLine->lineno, s);
+ if (s == NULL)
+ printf("%s:%d\n", filename, currentLine->lineno);
+ else
+ printf("%s:%d:%s\n", filename, currentLine->lineno, s);
}
static void poperrorskip (const char *s)
@@ -507,6 +510,35 @@ static void poperrorskip (const char *s)
}
}
+/* skipnewline skips all '\n' at the start of the line and returns
+ the new position. */
+
+static
+char *
+skipnewline (char *line)
+{
+ while (((*line) != (char)0) && ((*line) == '\n'))
+ line++;
+ return line;
+}
+
+/* traceLine display the source line providing -fdebug-trace-line was
+ enabled. */
+
+static
+void
+traceLine (void)
+{
+ if (M2Options_GetDebugTraceLine ())
+ {
+ char *line = skipnewline (currentLine->linebuf);
+ if (filename == NULL)
+ printf("<stdin>:%d:%s\n", currentLine->lineno, line);
+ else
+ printf("%s:%d:%s\n", filename, currentLine->lineno, line);
+ }
+}
+
/*
* consumeLine - reads a line into a buffer, it then pushes back the whole
* line except the initial \n.
@@ -527,6 +559,7 @@ static void consumeLine (void)
currentLine->column=0;
START_LINE (lineno, yyleng);
yyless(1); /* push back all but the \n */
+ traceLine ();
}
static void assert_location (location_t location ATTRIBUTE_UNUSED)
