mirrors/gcc
1
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2024-11-23 02:44:18 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

PR modula2/114745: const cast causes ICE

Browse Source 
This patch allows SYSTEM.CAST to be used during a const expression and
prevents an ICE.

gcc/m2/ChangeLog:

	PR modula2/114745
	* gm2-compiler/M2Code.mod (DumpLangDecl): Replace with ...
	(GetDumpDecl): ... this.
	(DumpLangGimple): Replace with ...
	(GetDumpGimple): ... this.
	* gm2-compiler/M2GenGCC.mod:
	* gm2-compiler/M2LangDump.mod (GetDumpLangQuadFilename): Replace with ...
	(GetDumpQuadFilename): ... this.
	(GetDumpLangDeclFilename): Replace with ...
	(GetDumpDeclFilename): ... this.
	(GetDumpLangGimpleFilename): Replace with ...
	(GetDumpGimpleFilename): ... this.
	* gm2-compiler/M2Options.def (GetDumpLangDeclFilename): New
	procedure function.
	(GetDumpDeclFilename): Ditto.
	(SetDumpLangDeclFilename): New procedure.
	(SetDumpDeclFilename): Ditto.
	(GetDumpLangQuadFilename): New procedure function.
	(GetDumpQuadFilename): Ditto
	(SetDumpLangQuadFilename): New procedure.
	(SetDumpQuadFilename): Ditto.
	(GetDumpLangGimpleFilename): New procedure function.
	(GetDumpGimpleFilename): Ditto.
	(SetDumpLangGimpleFilename): New procedure.
	(SetDumpGimpleFilename): Ditto.
	(GetDumpLangGimple): New procedure function.
	(SetM2Dump): New procedure.
	(GetDumpGimple): New procedure function.
	(GetDumpQuad): Ditto.
	(GetDumpDecl): Ditto.
	* gm2-compiler/M2Options.mod (DumpLangDeclFilename): Remove.
	(DumpLangQuadFilename): Ditto.
	(DumpLangGimpleFilename): Ditto.
	(DumpDeclFilename): New variable.
	(DumpQuadFilename): Ditto.
	(DumpGimpleFilename): Ditto.
	(DebugTraceTree): New variable.
	(SetQuadDebugging): Rewrite.
	(GetDumpLangDeclFilename): Replace with ...
	(GetDumpDeclFilename): ... this.
	(SetDumpLangQuadFilename): Replace with ...
	(SetDumpQuadFilename): ... this.
	(GetDumpLangGimpleFilename): Replace with ...
	(GetDumpGimpleFilename): ... this.
	(SetDumpLangGimpleFilename): Replace with ...
	(SetDumpGimpleFilename): ... this.
	(GetDumpLangGimple): Remove.
	(MatchDump): New procedure function.
	(SetM2Dump): New procedure.
	(GetDumpGimple): New procedure function.
	(GetDumpQuad): Ditto.
	(GetDumpDecl): Ditto.
	(GetDumpLangGimple): Ditto.
	* gm2-compiler/M2Quads.mod (BreakAtQuad): Assigned to 140.
	(BuildTypeCoercion): Add ConstExpr parameter.
	Check for const parameter in a const expression.
	Create a constant temporary if in a const expression.
	(BuildCastFunction): Pass ConstExpr to BuildTypeCoercion.
	(BuildFunctionCall): Pass ConstExpr to BuildTypeCoercion.
	* gm2-compiler/PCSymBuild.mod (buildConstFunction): Test for Cast
	and call InitConvert.
	(ErrorConstFunction): Add CAST to the error message.
	* gm2-compiler/SymbolTable.mod (GetConstStringContent): Remove
	unused procedure.
	* gm2-gcc/m2decl.cc (m2decl_DeclareKnownConstant): Copy value
	and change type of value.
	* gm2-gcc/m2options.h (M2Options_GetDumpLangDeclFilename): Remove.
	(M2Options_SetDumpLangDeclFilename): Ditto.
	(M2Options_GetDumpLangQuadFilename): Ditto.
	(M2Options_SetDumpLangQuadFilename): Ditto.
	(M2Options_GetDumpLangGimpleFilename): Ditto.
	(M2Options_SetDumpLangGimpleFilename): Ditto.
	(M2Options_GetDumpLangGimple): Ditto.
	(M2Options_GetDumpDeclFilename): New function.
	(M2Options_SetDumpDeclFilename): Ditto.
	(M2Options_GetDumpQuadFilename): Ditto.
	(M2Options_SetDumpQuadFilename): Ditto.
	(M2Options_GetDumpGimpleFilename): Ditto.
	(M2Options_SetDumpGimpleFilename): Ditto.
	(M2Options_SetM2Dump): Ditto.
	(M2Options_GetDumpGimple): Ditto.
	* gm2-gcc/m2pp.cc (GM2): New define.
	(m2pp_type_lowlevel): Remove linefeed.
	(m2pp_identifier): Add type description for const.
	(m2pp_assignment): Display lhs/rhs types.
	(m2pp_dump_gimple): Replace GetDumpLangGimple with GetDumpGimple.
	* gm2-lang.cc (ENABLE_QUAD_DUMP_ALL): Remove.
	(ENABLE_M2DUMP_ALL): New define.
	(gm2_langhook_handle_option): Remove commented options
	OPT_fdump_lang_all, OPT_fdump_lang_decl_, OPT_fdump_lang_gimple,
	OPT_fdump_lang_gimple_, OPT_fdump_lang_quad and
	OPT_fdump_lang_quad_.
	Add commented options OPT_fm2_dump_, OPT_fm2_dump_decl_,
	OPT_fm2_dump_gimple_ and OPT_fm2_dump_quad_.

gcc/testsuite/ChangeLog:

	PR modula2/114745
	* gm2/iso/const/pass/constcast.mod: New test.
	* gm2/iso/const/pass/constodd.mod: New test.
	* gm2/pim/pass/tinyindr.mod: New test.

Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
This commit is contained in:
Gaius Mulley 2024-04-16 23:08:43 +01:00
parent f438acf7ce
commit eadd05d560
15 changed files with 341 additions and 166 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/m2/gm2-compiler/M2Code.mod
View File

@ -26,7 +26,7 @@ FROM SYSTEM IMPORT WORD ;
FROM M2Options IMPORT Statistics, OptimizeUncalledProcedures,
OptimizeCommonSubExpressions,
StyleChecking, Optimizing, WholeProgram,
DumpLangDecl, DumpLangGimple ;
GetDumpDecl, GetDumpGimple ;
FROM M2LangDump IMPORT CreateDumpDecl, CloseDumpDecl, MakeGimpleTemplate ;
FROM M2Error IMPORT InternalError ;
@ -171,7 +171,7 @@ END RemoveUnreachableCode ;
PROCEDURE DoModuleDeclare ;
BEGIN
IF DumpLangDecl
IF GetDumpDecl ()
THEN
CreateDumpDecl ("symbol resolver of filtered symbols\n") ;
DumpFilteredResolver
@ -182,7 +182,7 @@ BEGIN
ELSE
StartDeclareScope (GetMainModule ())
END ;
IF DumpLangDecl
IF GetDumpDecl ()
THEN
CloseDumpDecl ;
CreateDumpDecl ("definitive declaration of filtered symbols\n") ;
@ -216,7 +216,7 @@ VAR
filename: String ;
len : CARDINAL ;
BEGIN
IF DumpLangGimple
IF GetDumpGimple ()
THEN
filename := MakeGimpleTemplate (len) ;
CreateDumpGimple (filename, len) ;

26
gcc/m2/gm2-compiler/M2GenGCC.mod
View File

@ -2950,9 +2950,11 @@ BEGIN
virtpos := MakeVirtualTok (becomespos, despos, exprpos) ;
CheckOrResetOverflow (exprpos, Mod2Gcc (des), MustCheckOverflow (quad)) ;
AddModGcc (des,
DeclareKnownConstant (TokenToLocation (virtpos),
Mod2Gcc (GetType (expr)),
Mod2Gcc (expr)))
BuildConvert (TokenToLocation (virtpos),
Mod2Gcc (GetType (des)),
DeclareKnownConstant (TokenToLocation (virtpos),
Mod2Gcc (GetType (expr)),
Mod2Gcc (expr)), FALSE))
END
END ;
RemoveQuad (p, des, quad) ;
@ -5328,13 +5330,18 @@ BEGIN
IF IsValueSolved (left) AND IsValueSolved (right)
THEN
(* We can take advantage of the known values and evaluate the condition. *)
PushValue (left) ;
PushValue (right) ;
IF Less (tokenno)
IF IsBooleanRelOpPattern (quad)
THEN
PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
FoldBooleanRelopPattern (p, quad)
ELSE
SubQuad (quad)
PushValue (left) ;
PushValue (right) ;
IF Less (tokenno)
THEN
PutQuad (quad, GotoOp, NulSym, NulSym, destQuad)
ELSE
SubQuad (quad)
END
END ;
NoChange := FALSE
END
@ -7795,7 +7802,6 @@ PROCEDURE IsValidExpressionRelOp (quad: CARDINAL; isin: BOOLEAN) : BOOLEAN ;
CONST
Verbose = FALSE ;
VAR
lefttype, righttype,
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
constExpr, overflow : BOOLEAN ;
@ -7810,8 +7816,6 @@ BEGIN
DeclareConstant (rightpos, right) ;
DeclareConstructor (leftpos, quad, left) ;
DeclareConstructor (rightpos, quad, right) ;
lefttype := GetType (left) ;
righttype := GetType (right) ;
IF ExpressionTypeCompatible (combined, "", left, right,
StrictTypeChecking, isin)
THEN

10
gcc/m2/gm2-compiler/M2LangDump.mod
View File

@ -40,8 +40,8 @@ FROM SymbolTable IMPORT NulSym,
IsExported, IsPublic, IsExtern, IsMonoName,
IsDefinitionForC ;
FROM M2Options IMPORT GetM2DumpFilter, GetDumpDir, GetDumpLangQuadFilename,
GetDumpLangDeclFilename, GetDumpLangGimpleFilename ;
FROM M2Options IMPORT GetM2DumpFilter, GetDumpDir, GetDumpQuadFilename,
GetDumpDeclFilename, GetDumpGimpleFilename ;
FROM M2GCCDeclare IMPORT IncludeDumpSymbol ;
FROM FormatStrings IMPORT Sprintf0, Sprintf1 ;
@ -751,7 +751,7 @@ END CreateTemplate ;
PROCEDURE MakeQuadTemplate () : String ;
BEGIN
RETURN CreateTemplate (GetDumpLangQuadFilename (), InitString ('quad'))
RETURN CreateTemplate (GetDumpQuadFilename (), InitString ('quad'))
END MakeQuadTemplate ;
@ -761,7 +761,7 @@ END MakeQuadTemplate ;
PROCEDURE MakeDeclTemplate () : String ;
BEGIN
RETURN CreateTemplate (GetDumpLangDeclFilename (), InitString ('decl'))
RETURN CreateTemplate (GetDumpDeclFilename (), InitString ('decl'))
END MakeDeclTemplate ;
@ -775,7 +775,7 @@ PROCEDURE MakeGimpleTemplate (VAR len: CARDINAL) : String ;
VAR
filename: String ;
BEGIN
filename := CreateTemplate (GetDumpLangGimpleFilename (), InitString ('gimple')) ;
filename := CreateTemplate (GetDumpGimpleFilename (), InitString ('gimple')) ;
len := Length (filename) ; (* This is a short cut based on '%03d' format
specifier used above. *)
RETURN filename

52
gcc/m2/gm2-compiler/M2Options.def
View File

@ -53,9 +53,6 @@ VAR
PedanticCast, (* -Wpedantic-cast warns if sizes differ. *)
Statistics, (* -fstatistics information about code *)
StyleChecking, (* -Wstudents checks for common student errs*)
DumpLangDecl, (* -fdump-lang-decl. *)
DumpLangGimple, (* -fdump-lang-gimple. *)
DumpLangQuad, (* -fq, -fdump-lang-quad dump quadruples. *)
UnboundedByReference, (* -funbounded-by-reference *)
VerboseUnbounded, (* -Wverbose-unbounded *)
OptimizeUncalledProcedures, (* -Ouncalled removes uncalled procedures *)
@ -1004,45 +1001,45 @@ PROCEDURE GetIEEELongDouble () : BOOLEAN ;
(*
GetDumpLangDeclFilename - returns the DumpLangDeclFilename.
GetDumpDeclFilename - returns the DumpLangDeclFilename.
*)
PROCEDURE GetDumpLangDeclFilename () : String ;
PROCEDURE GetDumpDeclFilename () : String ;
(*
SetDumpLangDeclFilename - set DumpLangDeclFilename to filename.
SetDumpDeclFilename - set DumpDeclFilename to filename.
*)
PROCEDURE SetDumpLangDeclFilename (value: BOOLEAN; filename: ADDRESS) ;
PROCEDURE SetDumpDeclFilename (value: BOOLEAN; filename: ADDRESS) ;
(*
GetDumpLangQuadFilename - returns the DumpLangQuadFilename.
GetDumpQuadFilename - returns the DumpQuadFilename.
*)
PROCEDURE GetDumpLangQuadFilename () : String ;
PROCEDURE GetDumpQuadFilename () : String ;
(*
SetDumpLangQuadFilename - set DumpLangQuadFilename to filename.
SetDumpQuadFilename - set DumpQuadFilename to filename.
*)
PROCEDURE SetDumpLangQuadFilename (value: BOOLEAN; filename: ADDRESS) ;
PROCEDURE SetDumpQuadFilename (value: BOOLEAN; filename: ADDRESS) ;
(*
GetDumpLangGimpleFilename - returns the DumpLangGimpleFilename.
GetDumpGimpleFilename - returns the DumpGimpleFilename.
*)
PROCEDURE GetDumpLangGimpleFilename () : String ;
PROCEDURE GetDumpGimpleFilename () : String ;
(*
SetDumpLangGimpleFilename - set DumpLangGimpleFilename to filename.
SetDumpGimpleFilename - set DumpGimpleFilename to filename.
*)
PROCEDURE SetDumpLangGimpleFilename (value: BOOLEAN; filename: ADDRESS) ;
PROCEDURE SetDumpGimpleFilename (value: BOOLEAN; filename: ADDRESS) ;
(*
@ -1061,10 +1058,31 @@ PROCEDURE GetM2DumpFilter () : ADDRESS ;
(*
GetDumpLangGimple - return TRUE if -fdump-lang-gimple is set.
SetM2Dump - sets the dump via a comma separated list: quad,decl,gimple,all.
*)
PROCEDURE GetDumpLangGimple () : BOOLEAN ;
PROCEDURE SetM2Dump (value: BOOLEAN; filter: ADDRESS) ;
(*
GetDumpGimple - return TRUE if the dump gimple flag is set from SetM2Dump.
*)
PROCEDURE GetDumpGimple () : BOOLEAN ;
(*
GetDumpQuad - return TRUE if the dump quad flag is set from SetM2Dump.
*)
PROCEDURE GetDumpQuad () : BOOLEAN ;
(*
GetDumpDecl - return TRUE if the dump quad flag is set from SetM2Dump.
*)
PROCEDURE GetDumpDecl () : BOOLEAN ;
(*

214
gcc/m2/gm2-compiler/M2Options.mod
View File

@ -57,9 +57,10 @@ CONST
DefaultRuntimeModuleOverride = "m2iso:RTentity,m2iso:Storage,m2iso:SYSTEM,m2iso:M2RTS,m2iso:RTExceptions,m2iso:IOLink" ;
VAR
DumpLangDeclFilename,
DumpLangQuadFilename,
DumpLangGimpleFilename,
DumpDeclFilename,
DumpQuadFilename,
DumpGimpleFilename,
M2Dump,
M2DumpFilter,
M2Prefix,
M2PathName,
@ -76,10 +77,13 @@ VAR
RuntimeModuleOverride,
CppArgs : String ;
DebugFunctionLineNumbers,
DebugTraceQuad, (* -fdebug-trace-quad. *)
DebugTraceTree, (* -fdebug-trace-tree. *)
DebugTraceLine, (* -fdebug-trace-line. *)
DebugTraceToken, (* -fdebug-trace-token. *)
DebugTraceQuad, (* -fm2-debug-trace=quad. *)
DebugTraceLine, (* -fm2-debug-trace=line. *)
DebugTraceToken, (* -fm2-debug-trace=token. *)
DebugTraceTree, (* -fm2-debug-trace=tree. (not yet implemented). *)
DumpDecl, (* -fm2-dump=decl. *)
DumpGimple, (* -fm2-dump=gimple. *)
DumpQuad, (* -fq, -fm2-dump=quad dump quadruples. *)
MFlag,
MMFlag,
MPFlag,
@ -1085,9 +1089,9 @@ END SetSwig ;
PROCEDURE SetQuadDebugging (value: BOOLEAN) ;
BEGIN
DumpLangQuad := value ;
DumpLangQuadFilename := KillString (DumpLangQuadFilename) ;
DumpLangQuadFilename := InitString ('-')
DumpQuad := value ;
DumpQuadFilename := KillString (DumpQuadFilename) ;
DumpQuadFilename := InitString ('-')
END SetQuadDebugging ;
@ -1140,7 +1144,7 @@ PROCEDURE SetM2DebugTrace (word: String; value: BOOLEAN) ;
BEGIN
IF EqualArray (word, 'all')
THEN
(* DebugTraceTree := value *)
(* DebugTraceTree := value ; *)
DebugTraceQuad := value ;
DebugTraceToken := value ;
DebugTraceLine := value
@ -1796,83 +1800,84 @@ END InitializeLongDoubleFlags ;
(*
GetDumpLangDeclFilename - returns the DumpLangDeclFilename.
GetDumpDeclFilename - returns the DumpDeclFilename.
*)
PROCEDURE GetDumpLangDeclFilename () : String ;
PROCEDURE GetDumpDeclFilename () : String ;
BEGIN
RETURN DumpLangDeclFilename
END GetDumpLangDeclFilename ;
RETURN DumpDeclFilename
END GetDumpDeclFilename ;
(*
SetDumpLangDeclFilename -
SetDumpDeclFilename -
*)
PROCEDURE SetDumpLangDeclFilename (value: BOOLEAN; filename: ADDRESS) ;
PROCEDURE SetDumpDeclFilename (value: BOOLEAN; filename: ADDRESS) ;
BEGIN
DumpLangDecl := value ;
DumpLangDeclFilename := KillString (DumpLangDeclFilename) ;
DumpDecl := value ;
DumpDeclFilename := KillString (DumpDeclFilename) ;
IF filename # NIL
THEN
DumpLangDeclFilename := InitStringCharStar (filename)
DumpDeclFilename := InitStringCharStar (filename)
END
END SetDumpLangDeclFilename ;
END SetDumpDeclFilename ;
(*
GetDumpLangQuadFilename - returns the DumpLangQuadFilename.
GetDumpQuadFilename - returns the DumpQuadFilename.
*)
PROCEDURE GetDumpLangQuadFilename () : String ;
PROCEDURE GetDumpQuadFilename () : String ;
BEGIN
RETURN DumpLangQuadFilename
END GetDumpLangQuadFilename ;
RETURN DumpQuadFilename
END GetDumpQuadFilename ;
(*
SetDumpLangQuadFilename -
SetDumpQuadFilename -
*)
PROCEDURE SetDumpLangQuadFilename (value: BOOLEAN; filename: ADDRESS) ;
PROCEDURE SetDumpQuadFilename (value: BOOLEAN; filename: ADDRESS) ;
BEGIN
DumpLangQuad := value ;
DumpLangQuadFilename := KillString (DumpLangQuadFilename) ;
DumpQuad := value ;
DumpQuadFilename := KillString (DumpQuadFilename) ;
IF filename # NIL
THEN
DumpLangQuadFilename := InitStringCharStar (filename)
DumpQuadFilename := InitStringCharStar (filename)
END
END SetDumpLangQuadFilename ;
END SetDumpQuadFilename ;
(*
GetDumpLangGimpleFilename - returns the DumpLangGimpleFilename.
GetDumpGimpleFilename - returns the DumpGimpleFilename.
*)
PROCEDURE GetDumpLangGimpleFilename () : String ;
PROCEDURE GetDumpGimpleFilename () : String ;
BEGIN
RETURN DumpLangGimpleFilename
END GetDumpLangGimpleFilename ;
RETURN DumpGimpleFilename
END GetDumpGimpleFilename ;
(*
SetDumpLangGimpleFilename - set DumpLangGimpleFilename to filename.
SetDumpGimpleFilename - set DumpGimpleFilename to filename.
*)
PROCEDURE SetDumpLangGimpleFilename (value: BOOLEAN; filename: ADDRESS) ;
PROCEDURE SetDumpGimpleFilename (value: BOOLEAN; filename: ADDRESS) ;
BEGIN
DumpLangGimple := value ;
DumpLangGimpleFilename := KillString (DumpLangGimpleFilename) ;
DumpGimple := value ;
DumpGimpleFilename := KillString (DumpGimpleFilename) ;
IF value AND (filename # NIL)
THEN
DumpLangGimpleFilename := InitStringCharStar (filename)
DumpGimpleFilename := InitStringCharStar (filename)
END
END SetDumpLangGimpleFilename ;
END SetDumpGimpleFilename ;
(*
SetM2DumpFilter - sets the filter to a comma separated list of procedures
and modules.
and modules. Not to be confused with SetM2Dump below
which enables the class of data structures to be dumped.
*)
PROCEDURE SetM2DumpFilter (value: BOOLEAN; filter: ADDRESS) ;
@ -1901,13 +1906,115 @@ END GetM2DumpFilter ;
(*
GetDumpLangGimple - return TRUE if -fdump-lang-gimple is set.
MatchDump - enable/disable dump using value. It returns TRUE if dump
is valid.
*)
PROCEDURE GetDumpLangGimple () : BOOLEAN ;
PROCEDURE MatchDump (dump: String; value: BOOLEAN) : BOOLEAN ;
BEGIN
RETURN DumpLangGimple
END GetDumpLangGimple ;
IF EqualArray (dump, 'all')
THEN
DumpDecl := value ;
DumpQuad := value ;
DumpGimple := value ;
RETURN TRUE
ELSIF EqualArray (dump, 'decl')
THEN
DumpDecl := value ;
RETURN TRUE
ELSIF EqualArray (dump, 'gimple')
THEN
DumpGimple := value ;
RETURN TRUE
ELSIF EqualArray (dump, 'quad')
THEN
DumpQuad := value ;
RETURN TRUE
END ;
RETURN FALSE
END MatchDump ;
(*
SetM2Dump - sets the dump via a comma separated list: quad,decl,gimple,all.
It returns TRUE if the comma separated list is valid.
*)
PROCEDURE SetM2Dump (value: BOOLEAN; filter: ADDRESS) : BOOLEAN ;
VAR
result: BOOLEAN ;
dump : String ;
start,
i : INTEGER ;
BEGIN
IF filter = NIL
THEN
RETURN FALSE
END ;
IF M2Dump # NIL
THEN
M2Dump := KillString (M2Dump)
END ;
M2Dump := InitStringCharStar (filter) ;
start := 0 ;
REPEAT
i := Index (M2Dump, ',', start) ;
IF i = -1
THEN
dump := Slice (M2Dump, start, 0)
ELSE
dump := Slice (M2Dump, start, i)
END ;
result := MatchDump (dump, value) ;
dump := KillString (dump) ;
IF NOT result
THEN
RETURN FALSE
END ;
start := i+1 ;
UNTIL i = -1 ;
RETURN TRUE
END SetM2Dump ;
(*
GetDumpGimple - return TRUE if the dump gimple flag is set from SetM2Dump.
*)
PROCEDURE GetDumpGimple () : BOOLEAN ;
BEGIN
RETURN DumpGimple
END GetDumpGimple ;
(*
GetDumpQuad - return TRUE if the dump quad flag is set from SetM2Dump.
*)
PROCEDURE GetDumpQuad () : BOOLEAN ;
BEGIN
RETURN DumpQuad
END GetDumpQuad ;
(*
GetDumpDecl - return TRUE if the dump decl flag is set from SetM2Dump.
*)
PROCEDURE GetDumpDecl () : BOOLEAN ;
BEGIN
RETURN DumpDecl
END GetDumpDecl ;
(*
GetDumpLangGimple - return TRUE if the gimple flag is set from SetM2Dump.
*)
PROCEDURE GetDumpGimple () : BOOLEAN ;
BEGIN
RETURN DumpGimple
END GetDumpGimple ;
BEGIN
@ -1931,7 +2038,7 @@ BEGIN
Quiet := TRUE ;
CC1Quiet := TRUE ;
Profiling := FALSE ;
DumpLangQuad := FALSE ;
DumpQuad := FALSE ;
OptimizeBasicBlock := FALSE ;
OptimizeUncalledProcedures := FALSE ;
OptimizeCommonSubExpressions := FALSE ;
@ -1994,11 +2101,12 @@ BEGIN
InitializeLongDoubleFlags ;
M2Prefix := InitString ('') ;
M2PathName := InitString ('') ;
DumpLangQuadFilename := NIL ;
DumpLangGimpleFilename := NIL ;
DumpLangDeclFilename := NIL ;
DumpLangDecl := FALSE ;
DumpLangQuad := FALSE ;
DumpLangGimple := FALSE ;
DumpQuadFilename := NIL ;
DumpGimpleFilename := NIL ;
DumpDeclFilename := NIL ;
DumpDecl := FALSE ;
DumpQuad := FALSE ;
DumpGimple := FALSE ;
M2Dump := NIL ;
M2DumpFilter := NIL
END M2Options.

30
gcc/m2/gm2-compiler/M2Quads.mod
View File

@ -222,7 +222,7 @@ FROM M2Options IMPORT NilChecking,
ScaffoldMain, SharedFlag, WholeProgram,
GetDumpDir, GetM2DumpFilter,
GetRuntimeModuleOverride, GetDebugTraceQuad,
DumpLangQuad ;
GetDumpQuad ;
FROM M2LangDump IMPORT CreateDumpQuad, CloseDumpQuad, GetDumpFile ;
FROM M2Pass IMPORT IsPassCodeGeneration, IsNoPass ;
@ -276,7 +276,7 @@ IMPORT M2Error, FIO, SFIO, DynamicStrings, StdIO ;
CONST
DebugStackOn = TRUE ;
DebugVarients = FALSE ;
BreakAtQuad = 189 ;
BreakAtQuad = 140 ;
DebugTokPos = FALSE ;
TYPE
@ -7794,7 +7794,7 @@ BEGIN
ELSIF IsAModula2Type (ProcSym)
THEN
ManipulatePseudoCallParameters ;
BuildTypeCoercion
BuildTypeCoercion (ConstExpr)
ELSIF IsPseudoSystemFunction (ProcSym) OR
IsPseudoBaseFunction (ProcSym)
THEN
@ -7942,7 +7942,7 @@ END BuildConstFunctionCall ;
differ.
*)
PROCEDURE BuildTypeCoercion ;
PROCEDURE BuildTypeCoercion (ConstExpr: BOOLEAN) ;
VAR
resulttok,
proctok,
@ -7964,18 +7964,24 @@ BEGIN
THEN
PopTrwtok (exp, r, exptok) ;
MarkAsRead (r) ;
resulttok := MakeVirtualTok (proctok, proctok, exptok) ;
ReturnVar := MakeTemporary (resulttok, RightValue) ;
PutVar (ReturnVar, ProcSym) ; (* Set ReturnVar's TYPE. *)
resulttok := MakeVirtual2Tok (proctok, exptok) ;
PopN (1) ; (* Pop procedure. *)
IF IsConst (exp) OR IsVar (exp)
IF ConstExprError (ProcSym, exp, exptok, ConstExpr)
THEN
ReturnVar := MakeTemporary (resulttok, ImmediateValue) ;
PutVar (ReturnVar, ProcSym) ; (* Set ReturnVar's TYPE. *)
ELSIF IsConst (exp) OR IsVar (exp)
THEN
ReturnVar := MakeTemporary (resulttok, AreConstant (IsConst (exp))) ;
PutVar (ReturnVar, ProcSym) ; (* Set ReturnVar's TYPE. *)
GenQuad (CoerceOp, ReturnVar, ProcSym, exp)
ELSE
MetaError2 ('trying to coerse {%1EMRad} which is not a variable or constant into {%2ad}',
exp, ProcSym) ;
MetaError2 ('trying to coerse {%1ECad} which is not a variable or constant into {%2ad}',
exp, ProcSym)
exp, ProcSym) ;
ReturnVar := MakeTemporary (resulttok, RightValue) ;
PutVar (ReturnVar, ProcSym) (* Set ReturnVar's TYPE. *)
END ;
PushTFtok (ReturnVar, ProcSym, resulttok)
ELSE
@ -9632,7 +9638,7 @@ BEGIN
PushTFtok (Type, NulSym, typetok) ;
PushTtok (Exp, exptok) ;
PushT (1) ; (* one parameter *)
BuildTypeCoercion
BuildTypeCoercion (ConstExpr)
ELSIF IsVar (Exp) OR IsProcedure (Exp)
THEN
PopN (NoOfParam + 1) ;
@ -11737,7 +11743,7 @@ BEGIN
Assert (GetSType (Sym) = Type) ;
ti := calculateMultipicand (indexTok, Sym, Type, Dim) ;
idx := OperandT (1) ;
IF IsConst (idx)
IF IsConst (idx) AND IsConst (ti)
THEN
(* tj has no type since constant *)
tj := MakeTemporary (indexTok, ImmediateValue) ;
@ -13708,7 +13714,7 @@ END DumpQuadrupleAll ;
PROCEDURE DumpQuadruples (title: ARRAY OF CHAR) ;
BEGIN
IF DumpLangQuad
IF GetDumpQuad ()
THEN
CreateDumpQuad (title) ;
IF GetM2DumpFilter () = NIL

8
gcc/m2/gm2-compiler/PCSymBuild.mod
View File

@ -39,7 +39,7 @@ FROM M2Quads IMPORT PushT, PopT, OperandT, PopN, PopTF, PushTF, IsAutoPushOn,
FROM M2Options IMPORT Iso ;
FROM StdIO IMPORT Write ;
FROM M2System IMPORT IsPseudoSystemFunctionConstExpression ;
FROM M2System IMPORT Cast, IsPseudoSystemFunctionConstExpression ;
FROM M2Base IMPORT MixTypes,
ZType, RType, Char, Boolean, Val, Max, Min, Convert,
@ -1399,7 +1399,7 @@ BEGIN
second := PopAddress (exprStack) ;
first := PopAddress (exprStack)
END ;
IF func=Val
IF (func=Val) OR (func=Cast)
THEN
InitConvert (cast, NulSym, first, second)
ELSIF (func=Max) OR (func=Min)
@ -1424,7 +1424,7 @@ BEGIN
IF Iso
THEN
ErrorFormat0 (NewError (functok),
'the only functions permissible in a constant expression are: CAP, CHR, CMPLX, FLOAT, HIGH, IM, LENGTH, MAX, MIN, ODD, ORD, RE, SIZE, TSIZE, TRUNC, VAL and gcc builtins')
'the only functions permissible in a constant expression are: CAP, CAST, CHR, CMPLX, FLOAT, HIGH, IM, LENGTH, MAX, MIN, ODD, ORD, RE, SIZE, TSIZE, TRUNC, VAL and gcc builtins')
ELSE
ErrorFormat0 (NewError (functok),
'the only functions permissible in a constant expression are: CAP, CHR, FLOAT, HIGH, MAX, MIN, ODD, ORD, SIZE, TSIZE, TRUNC, VAL and gcc builtins')
@ -1433,7 +1433,7 @@ BEGIN
IF Iso
THEN
MetaErrorT1 (functok,
'the only functions permissible in a constant expression are: CAP, CHR, CMPLX, FLOAT, HIGH, IM, LENGTH, MAX, MIN, ODD, ORD, RE, SIZE, TSIZE, TRUNC, VAL and gcc builtins, but not {%1Ead}',
'the only functions permissible in a constant expression are: CAP, CAST, CHR, CMPLX, FLOAT, HIGH, IM, LENGTH, MAX, MIN, ODD, ORD, RE, SIZE, TSIZE, TRUNC, VAL and gcc builtins, but not {%1Ead}',
func)
ELSE
MetaErrorT1 (functok,

21
gcc/m2/gm2-compiler/SymbolTable.mod
View File

@ -5082,27 +5082,6 @@ BEGIN
END InitConstString ;
(*
GetConstString - returns the contents of a string constant.
*)
PROCEDURE GetConstStringContent (sym: CARDINAL) : Name ;
VAR
pSym: PtrToSymbol ;
BEGIN
pSym := GetPsym (sym) ;
WITH pSym^ DO
CASE SymbolType OF
ConstStringSym: RETURN ConstString.Contents
ELSE
InternalError ('expecting ConstStringSym')
END
END
END GetConstStringContent ;
(*
IsConstStringNulTerminated - returns TRUE if the constant string, sym,
should be created with a nul terminator.

4
gcc/m2/gm2-gcc/m2decl.cc
View File

@ -152,11 +152,11 @@ m2decl_DeclareKnownConstant (location_t location, tree type, tree value)
decl = build_decl (location, CONST_DECL, id, type);
value = copy_node (value);
TREE_TYPE (value) = type;
DECL_INITIAL (decl) = value;
TREE_TYPE (decl) = type;
decl = m2block_global_constant (decl);
return decl;
}

15
gcc/m2/gm2-gcc/m2options.h
View File

@ -155,16 +155,17 @@ EXTERN void M2Options_SetIBMLongDouble (bool value);
EXTERN bool M2Options_GetIBMLongDouble (void);
EXTERN void M2Options_SetIEEELongDouble (bool value);
EXTERN bool M2Options_GetIEEELongDouble (void);
EXTERN bool M2Options_GetDumpLangDeclFilename (void);
EXTERN void M2Options_SetDumpLangDeclFilename (bool value, const char *arg);
EXTERN bool M2Options_GetDumpLangQuadFilename (void);
EXTERN void M2Options_SetDumpLangQuadFilename (bool value, const char *arg);
EXTERN bool M2Options_GetDumpLangGimpleFilename (void);
EXTERN void M2Options_SetDumpLangGimpleFilename (bool value, const char *arg);
EXTERN bool M2Options_GetDumpLangGimple (void);
EXTERN bool M2Options_GetDumpDeclFilename (void);
EXTERN void M2Options_SetDumpDeclFilename (bool value, const char *arg);
EXTERN bool M2Options_GetDumpQuadFilename (void);
EXTERN void M2Options_SetDumpQuadFilename (bool value, const char *arg);
EXTERN bool M2Options_GetDumpGimpleFilename (void);
EXTERN void M2Options_SetDumpGimpleFilename (bool value, const char *arg);
EXTERN void M2Options_SetM2DumpFilter (bool value, const char *args);
EXTERN char *M2Options_GetM2DumpFilter (void);
EXTERN void M2Options_SetM2DebugTraceFilter (bool value, const char *arg);
EXTERN bool M2Options_SetM2Dump (bool value, const char *arg);
EXTERN bool M2Options_GetDumpGimple (void);
#undef EXTERN
#endif /* m2options_h. */

31
gcc/m2/gm2-gcc/m2pp.cc
View File

@ -34,6 +34,8 @@ along with GNU Modula-2; see the file COPYING3. If not see
#define M2PP_C
#include "m2pp.h"
#define GM2
const char *m2pp_dump_description[M2PP_DUMP_END] =
{
"interactive user invoked output",
@ -526,9 +528,9 @@ m2pp_type_lowlevel (pretty *s, tree t)
m2pp_needspace (s);
if (TYPE_UNSIGNED (t))
m2pp_print (s, "unsigned\n");
m2pp_print (s, "unsigned");
else
m2pp_print (s, "signed\n");
m2pp_print (s, "signed");
}
}
@ -896,6 +898,19 @@ m2pp_identifier (pretty *s, tree t)
else
snprintf (name, 100, "D_%u", DECL_UID (t));
m2pp_print (s, name);
if (TREE_TYPE (t) != NULL_TREE)
{
m2pp_needspace (s);
m2pp_print (s, "(* type:");
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, "*)");
}
}
}
}
@ -2554,6 +2569,16 @@ m2pp_assignment (pretty *s, tree t)
int o;
m2pp_begin (s);
/* Print the types of des and expr. */
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");
/* Print the assignment statement. */
m2pp_designator (s, TREE_OPERAND (t, 0));
m2pp_needspace (s);
m2pp_print (s, ":=");
@ -2818,7 +2843,7 @@ m2pp_dump_gimple_pretty (m2pp_dump_kind kind, tree fndecl)
void
m2pp_dump_gimple (m2pp_dump_kind kind, tree fndecl)
{
if (M2Options_GetDumpLangGimple ()
if (M2Options_GetDumpGimple ()
&& M2LangDump_IsDumpRequiredTree (fndecl, true))
m2pp_dump_gimple_pretty (kind, fndecl);
}

40
gcc/m2/gm2-lang.cc
View File

@ -42,7 +42,7 @@ Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
#include "convert.h"
#include "rtegraph.h"
#undef ENABLE_QUAD_DUMP_ALL
#undef ENABLE_M2DUMP_ALL
static void write_globals (void);
@ -478,31 +478,6 @@ gm2_langhook_handle_option (
case OPT_fdebug_function_line_numbers:
M2Options_SetDebugFunctionLineNumbers (value);
return 1;
#ifdef ENABLE_QUAD_DUMP_ALL
case OPT_fdump_lang_all:
M2Options_SetDumpLangDeclFilename (value, NULL);
M2Options_SetDumpLangGimpleFilename (value, NULL);
M2Options_SetDumpLangQuadFilename (value, NULL);
return 1;
case OPT_fdump_lang_decl:
M2Options_SetDumpLangDeclFilename (value, NULL);
return 1;
case OPT_fdump_lang_decl_:
M2Options_SetDumpLangDeclFilename (value, arg);
return 1;
case OPT_fdump_lang_gimple:
M2Options_SetDumpLangGimpleFilename (value, NULL);
return 1;
case OPT_fdump_lang_gimple_:
M2Options_SetDumpLangGimpleFilename (value, arg);
return 1;
case OPT_fdump_lang_quad:
M2Options_SetDumpLangQuadFilename (value, NULL);
return 1;
case OPT_fdump_lang_quad_:
M2Options_SetDumpLangQuadFilename (value, arg);
return 1;
#endif
case OPT_fauto_init:
M2Options_SetAutoInit (value);
return 1;
@ -546,7 +521,18 @@ gm2_langhook_handle_option (
case OPT_fm2_debug_trace_:
M2Options_SetM2DebugTraceFilter (value, arg);
return 1;
#ifdef ENABLE_QUAD_DUMP_ALL
#ifdef ENABLE_M2DUMP_ALL
case OPT_fm2_dump_:
return M2Options_SetM2Dump (value, arg);
case OPT_fm2_dump_decl_:
M2Options_SetDumpDeclFilename (value, arg);
return 1;
case OPT_fm2_dump_gimple_:
M2Options_SetDumpGimpleFilename (value, arg);
return 1;
case OPT_fm2_dump_quad_:
M2Options_SetDumpQuadFilename (value, arg);
return 1;
case OPT_fm2_dump_filter_:
M2Options_SetM2DumpFilter (value, arg);
return 1;

8
gcc/testsuite/gm2/iso/const/pass/constcast.mod Normal file
View File

@ -0,0 +1,8 @@
MODULE constcast ;
FROM SYSTEM IMPORT CAST ;
CONST Nil = CAST (PROC, NIL) ;
BEGIN
END constcast.

16
gcc/testsuite/gm2/iso/const/pass/constodd.mod Normal file
View File

@ -0,0 +1,16 @@
MODULE constodd ;
FROM libc IMPORT printf, exit ;
CONST
IsOdd = ODD (1) AND (2 > 1) ;
BEGIN
IF IsOdd
THEN
printf ("success\n");
ELSE
printf ("failure\n");
exit (1)
END
END constodd.

24
gcc/testsuite/gm2/pim/pass/tinyindr.mod Normal file
View File

@ -0,0 +1,24 @@
MODULE tinyindr ;
FROM SYSTEM IMPORT WORD, BYTE ;
TYPE
File = RECORD
lastWord: WORD ;
lastByte: BYTE ;
END ;
PROCEDURE Create (VAR f: File) ;
BEGIN
WITH f DO
lastWord := WORD (0) ;
lastByte := BYTE (0)
END
END Create ;
VAR
foo: File ;
BEGIN
Create (foo)
END tinyindr.