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 ;
END ;
location := TokenToLocation (CurrentQuadToken) ;
CheckReferenced(q, op) ;
- IF DebugTraceQuad
+ IF GetDebugTraceQuad ()
THEN
printf0('building: ') ;
DisplayQuad(q)
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 ;
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,
*)
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 ;
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. *)
(* the shared library version of the *)
(* scaffold. *)
ForcedLocation,
- DebugFunctionLineNumbers,
GenerateStatementNote,
Optimizing,
Coding,
(*
- 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) ;
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.
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 ;
UselistFilename,
RuntimeModuleOverride,
CppArgs : String ;
+ DebugFunctionLineNumbers,
+ DebugTraceQuad, (* -fdebug-trace-quad. *)
+ DebugTraceTree, (* -fdebug-trace-tree. *)
+ DebugTraceLine, (* -fdebug-trace-line. *)
+ DebugTraceToken, (* -fdebug-trace-token. *)
MFlag,
MMFlag,
MPFlag,
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.
(*
- 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 ;
(*
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.
ForcedLocation := FALSE ;
WholeProgram := FALSE ;
DebugTraceQuad := FALSE ;
- DebugTraceAPI := FALSE ;
+ DebugTraceTree := FALSE ;
+ DebugTraceLine := FALSE ;
+ DebugTraceToken := FALSE ;
DebugFunctionLineNumbers := FALSE ;
GenerateStatementNote := FALSE ;
LowerCaseKeywords := FALSE ;
ScaffoldDynamic, ScaffoldStatic, cflag,
ScaffoldMain, SharedFlag, WholeProgram,
GetDumpDir, GetM2DumpFilter,
- GetRuntimeModuleOverride,
+ GetRuntimeModuleOverride, GetDebugTraceQuad,
DumpLangQuad ;
FROM M2LangDump IMPORT CreateDumpQuad, CloseDumpQuad, GetDumpFile ;
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 ;
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 ;
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 ;
PROCEDURE DebugLineNumbers (sym: CARDINAL) ;
BEGIN
- IF DebugFunctionLineNumbers
+ IF GetDebugFunctionLineNumbers ()
THEN
printf0 ('<lines>\n') ;
ForeachProcedureDo(sym, DebugProcedureLineNumber) ;
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[]);
_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);
}
#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
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.
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. */
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);
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. */
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;
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);
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
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
}
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)
}
}
+/* 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.
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)
projects / thirdparty / gcc.git / commitdiff
