FROM M2Options IMPORT Statistics, OptimizeUncalledProcedures,
OptimizeCommonSubExpressions,
StyleChecking, Optimizing, WholeProgram,
- DumpLangDecl, DumpLangGimple ;
+ GetDumpDecl, GetDumpGimple ;
FROM M2LangDump IMPORT CreateDumpDecl, CloseDumpDecl, MakeGimpleTemplate ;
FROM M2Error IMPORT InternalError ;
PROCEDURE DoModuleDeclare ;
BEGIN
- IF DumpLangDecl
+ IF GetDumpDecl ()
THEN
CreateDumpDecl ("symbol resolver of filtered symbols\n") ;
DumpFilteredResolver
ELSE
StartDeclareScope (GetMainModule ())
END ;
- IF DumpLangDecl
+ IF GetDumpDecl ()
THEN
CloseDumpDecl ;
CreateDumpDecl ("definitive declaration of filtered symbols\n") ;
filename: String ;
len : CARDINAL ;
BEGIN
- IF DumpLangGimple
+ IF GetDumpGimple ()
THEN
filename := MakeGimpleTemplate (len) ;
CreateDumpGimple (filename, len) ;
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) ;
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
CONST
Verbose = FALSE ;
VAR
- lefttype, righttype,
left, right, dest, combined,
leftpos, rightpos, destpos : CARDINAL ;
constExpr, overflow : BOOLEAN ;
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
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 ;
PROCEDURE MakeQuadTemplate () : String ;
BEGIN
- RETURN CreateTemplate (GetDumpLangQuadFilename (), InitString ('quad'))
+ RETURN CreateTemplate (GetDumpQuadFilename (), InitString ('quad'))
END MakeQuadTemplate ;
PROCEDURE MakeDeclTemplate () : String ;
BEGIN
- RETURN CreateTemplate (GetDumpLangDeclFilename (), InitString ('decl'))
+ RETURN CreateTemplate (GetDumpDeclFilename (), InitString ('decl'))
END MakeDeclTemplate ;
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
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 *)
(*
- 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) ;
(*
(*
- 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 ;
(*
DefaultRuntimeModuleOverride = "m2iso:RTentity,m2iso:Storage,m2iso:SYSTEM,m2iso:M2RTS,m2iso:RTExceptions,m2iso:IOLink" ;
VAR
- DumpLangDeclFilename,
- DumpLangQuadFilename,
- DumpLangGimpleFilename,
+ DumpDeclFilename,
+ DumpQuadFilename,
+ DumpGimpleFilename,
+ M2Dump,
M2DumpFilter,
M2Prefix,
M2PathName,
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,
PROCEDURE SetQuadDebugging (value: BOOLEAN) ;
BEGIN
- DumpLangQuad := value ;
- DumpLangQuadFilename := KillString (DumpLangQuadFilename) ;
- DumpLangQuadFilename := InitString ('-')
+ DumpQuad := value ;
+ DumpQuadFilename := KillString (DumpQuadFilename) ;
+ DumpQuadFilename := InitString ('-')
END SetQuadDebugging ;
BEGIN
IF EqualArray (word, 'all')
THEN
- (* DebugTraceTree := value *)
+ (* DebugTraceTree := value ; *)
DebugTraceQuad := value ;
DebugTraceToken := value ;
DebugTraceLine := value
(*
- 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) ;
(*
- 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
Quiet := TRUE ;
CC1Quiet := TRUE ;
Profiling := FALSE ;
- DumpLangQuad := FALSE ;
+ DumpQuad := FALSE ;
OptimizeBasicBlock := FALSE ;
OptimizeUncalledProcedures := FALSE ;
OptimizeCommonSubExpressions := FALSE ;
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.
ScaffoldMain, SharedFlag, WholeProgram,
GetDumpDir, GetM2DumpFilter,
GetRuntimeModuleOverride, GetDebugTraceQuad,
- DumpLangQuad ;
+ GetDumpQuad ;
FROM M2LangDump IMPORT CreateDumpQuad, CloseDumpQuad, GetDumpFile ;
FROM M2Pass IMPORT IsPassCodeGeneration, IsNoPass ;
CONST
DebugStackOn = TRUE ;
DebugVarients = FALSE ;
- BreakAtQuad = 189 ;
+ BreakAtQuad = 140 ;
DebugTokPos = FALSE ;
TYPE
ELSIF IsAModula2Type (ProcSym)
THEN
ManipulatePseudoCallParameters ;
- BuildTypeCoercion
+ BuildTypeCoercion (ConstExpr)
ELSIF IsPseudoSystemFunction (ProcSym) OR
IsPseudoBaseFunction (ProcSym)
THEN
differ.
*)
-PROCEDURE BuildTypeCoercion ;
+PROCEDURE BuildTypeCoercion (ConstExpr: BOOLEAN) ;
VAR
resulttok,
proctok,
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
PushTFtok (Type, NulSym, typetok) ;
PushTtok (Exp, exptok) ;
PushT (1) ; (* one parameter *)
- BuildTypeCoercion
+ BuildTypeCoercion (ConstExpr)
ELSIF IsVar (Exp) OR IsProcedure (Exp)
THEN
PopN (NoOfParam + 1) ;
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) ;
PROCEDURE DumpQuadruples (title: ARRAY OF CHAR) ;
BEGIN
- IF DumpLangQuad
+ IF GetDumpQuad ()
THEN
CreateDumpQuad (title) ;
IF GetM2DumpFilter () = NIL
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,
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)
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')
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,
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.
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;
}
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. */
#define M2PP_C
#include "m2pp.h"
+#define GM2
+
const char *m2pp_dump_description[M2PP_DUMP_END] =
{
"interactive user invoked output",
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");
}
}
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, "*)");
+ }
}
}
}
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, ":=");
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);
}
#include "convert.h"
#include "rtegraph.h"
-#undef ENABLE_QUAD_DUMP_ALL
+#undef ENABLE_M2DUMP_ALL
static void write_globals (void);
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;
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;
--- /dev/null
+MODULE constcast ;
+
+FROM SYSTEM IMPORT CAST ;
+
+CONST Nil = CAST (PROC, NIL) ;
+
+BEGIN
+END constcast.
\ No newline at end of file
--- /dev/null
+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.
--- /dev/null
+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.
projects / thirdparty / gcc.git / commitdiff
