PushRealTree, PopRealTree,
PushComplexTree, PopComplexTree,
PopConstructorTree,
+ PopChar,
PushCard,
PushInt,
PushChar,
(*
+ PopChar - returns the value from the stack in a character.
+*)
+
+PROCEDURE PopChar (tokenno: CARDINAL) : CHAR ;
+
+
+(*
PushString - pushes the numerical value of the string onto the stack.
*)
BuildDivTrunc, BuildModTrunc, BuildDivFloor, BuildModFloor,
BuildLSL, BuildLSR,
BuildLogicalOr, BuildLogicalAnd, BuildSymmetricDifference,
- GetWordOne, GetCardinalZero, TreeOverflow, RemoveOverflow ;
+ GetWordOne, GetCardinalZero, TreeOverflow, RemoveOverflow,
+ GetCstInteger ;
FROM m2decl IMPORT GetBitsPerBitset, BuildIntegerConstant, BuildConstLiteralNumber ;
FROM m2misc IMPORT DebugTree ;
(*
+ PopChar - pops a char from the stack.
+*)
+
+PROCEDURE PopChar (tokenno: CARDINAL) : CHAR ;
+VAR
+ v : PtrToValue ;
+ ch: CHAR ;
+BEGIN
+ v := Pop () ;
+ ch := 0C ;
+ WITH v^ DO
+ IF type = integer
+ THEN
+ ch := VAL (CHAR, GetCstInteger (numberValue))
+ ELSE
+ MetaErrorT0 (tokenno, '{%E}cannot convert constant to a CHAR')
+ END
+ END ;
+ Push (v) ;
+ RETURN ch
+END PopChar ;
+
+
+(*
IsReal - returns TRUE if a is a REAL number.
*)
FROM M2Batch IMPORT MakeDefinitionSource ;
FROM NameKey IMPORT Name, MakeKey, NulName, KeyToCharStar, makekey ;
FROM M2FileName IMPORT CalculateFileName ;
-FROM DynamicStrings IMPORT String, string, InitString, KillString, InitStringCharStar, Mark ;
+FROM DynamicStrings IMPORT String, string, InitString, KillString, InitStringCharStar, InitStringChar, Mark ;
FROM FormatStrings IMPORT Sprintf1 ;
FROM M2LexBuf IMPORT TokenToLineNo, FindFileNameFromToken, TokenToLocation, UnknownTokenNo, BuiltinTokenNo ;
FROM M2MetaError IMPORT MetaError1, MetaError3 ;
FROM M2ALU IMPORT Addn, Sub, Equ, GreEqu, Gre, Less, PushInt, PushCard, ConvertToType,
PushIntegerTree, PopIntegerTree, PopRealTree, ConvertToInt, PopSetTree,
+ PopChar,
IsConstructorDependants, WalkConstructorDependants,
PopConstructorTree, PopComplexTree, PutConstructorSolved,
ChangeToConstructor, EvaluateValue, TryEvaluateValue ;
PROCEDURE PromoteToString (tokenno: CARDINAL; sym: CARDINAL) : Tree ;
VAR
size: CARDINAL ;
+ ch : CHAR ;
BEGIN
DeclareConstant (tokenno, sym) ;
- size := GetStringLength (sym) ;
- IF size > 1
+ IF IsConst (sym) AND (GetSType (sym) = Char)
THEN
- (* will be a string anyway *)
- RETURN Tree (Mod2Gcc (sym))
+ PushValue (sym) ;
+ ch := PopChar (tokenno) ;
+ RETURN BuildCStringConstant (string (InitStringChar (ch)), 1)
ELSE
- RETURN BuildStringConstant (KeyToCharStar (GetString (sym)),
- GetStringLength (sym))
+ size := GetStringLength (sym) ;
+ IF size > 1
+ THEN
+ (* will be a string anyway *)
+ RETURN Tree (Mod2Gcc (sym))
+ ELSE
+ RETURN BuildStringConstant (KeyToCharStar (GetString (sym)),
+ GetStringLength (sym))
+ END
END
END PromoteToString ;
FROM NameKey IMPORT Name, MakeKey, KeyToCharStar, LengthKey, makekey, NulName ;
FROM DynamicStrings IMPORT string, InitString, KillString, String,
- InitStringCharStar, Mark, Slice, ConCat, ConCatChar ;
+ InitStringCharStar, Mark, Slice, ConCat, ConCatChar,
+ InitStringChar, Dup ;
FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3, Sprintf4 ;
FROM M2System IMPORT Address, Word, System, TBitSize, MakeAdr, IsSystemType, IsGenericSystemType, IsRealN, IsComplexN, IsSetN, IsWordN, Loc, Byte ;
PushSetTree, PopSetTree,
PopRealTree, PushCard,
PushRealTree,
- PopComplexTree,
+ PopComplexTree, PopChar,
Gre, Sub, Equ, NotEqu, LessEqu,
BuildRange, SetOr, SetAnd, SetNegate,
SetSymmetricDifference, SetDifference,
(*
+ IsConstStr - returns TRUE if sym is a constant string or a char constant.
+*)
+
+PROCEDURE IsConstStr (sym: CARDINAL) : BOOLEAN ;
+BEGIN
+ RETURN IsConstString (sym) OR (IsConst (sym) AND (GetSType (sym) = Char))
+END IsConstStr ;
+
+
+(*
+ GetStr - return a string containing a constant string value associated with sym.
+ A nul char constant will return an empty string.
+*)
+
+PROCEDURE GetStr (tokenno: CARDINAL; sym: CARDINAL) : String ;
+VAR
+ ch: CHAR ;
+BEGIN
+ Assert (IsConst (sym)) ;
+ IF IsConstString (sym)
+ THEN
+ RETURN InitStringCharStar (KeyToCharStar (GetString (sym)))
+ ELSE
+ Assert (GetSType (sym) = Char) ;
+ PushValue (sym) ;
+ ch := PopChar (tokenno) ;
+ RETURN InitStringChar (ch)
+ END
+END GetStr ;
+
+
+(*
FoldAdd - check addition for constant folding.
*)
VAR
s: String ;
BEGIN
- IF IsConst(op2) AND IsConst(op3) AND IsConst(op3) AND
- IsConstString(op2) AND IsConstString(op3)
+ IF IsConstStr (op2) AND IsConstStr (op3)
THEN
- (* handle special addition for constant strings *)
- s := InitStringCharStar(KeyToCharStar(GetString(op2))) ;
- s := ConCat(s, Mark(InitStringCharStar(KeyToCharStar(GetString(op3))))) ;
- PutConstString(tokenno, op1, makekey(string(s))) ;
- TryDeclareConstant(tokenno, op1) ;
- p(op1) ;
+ (* Handle special addition for constant strings. *)
+ s := Dup (GetStr (tokenno, op2)) ;
+ s := ConCat (s, GetStr (tokenno, op3)) ;
+ PutConstString (tokenno, op1, makekey (string (s))) ;
+ TryDeclareConstant (tokenno, op1) ;
+ p (op1) ;
NoChange := FALSE ;
- SubQuad(quad) ;
- s := KillString(s)
+ SubQuad (quad) ;
+ s := KillString (s)
ELSE
IF BinaryOperands (quad, op2, op3)
THEN
BEGIN
location := TokenToLocation (CurrentQuadToken) ;
- DeclareConstant(CurrentQuadToken, array) ;
- IF IsConstString(array)
+ DeclareConstant (CurrentQuadToken, array) ;
+ IF IsConstString (array) OR (IsConst (array) AND (GetSType (array) = Char))
THEN
BuildAssignmentStatement (location, Mod2Gcc (result), BuildAddr (location, PromoteToString (CurrentQuadToken, array), FALSE))
- ELSIF IsConstructor(array)
+ ELSIF IsConstructor (array)
THEN
BuildAssignmentStatement (location, Mod2Gcc (result), BuildAddr (location, Mod2Gcc (array), TRUE))
ELSIF IsUnbounded (GetType (array))
END
END ;
- i := GetNextQuad(i)
+ i := GetNextQuad (i)
END ;
InternalError ('fix this for the sake of efficiency..')
END IsBackReference ;
END
END ;
- i := GetNextQuad(i)
+ i := GetNextQuad (i)
END ;
InternalError ('fix this for the sake of efficiency..')
END IsBackReferenceConditional ;
return value;
}
+
+/* GetCstInteger return the integer value of the cst tree. */
+
+int
+m2expr_GetCstInteger (tree cst)
+{
+ return TREE_INT_CST_LOW (cst);
+}
+
+
/* init initialise this module. */
void
(*
+ GetCstInteger - return the integer value of the cst tree.
+*)
+
+PROCEDURE GetCstInteger (cst: Tree) : INTEGER ;
+
+
+(*
AreConstantsEqual - maps onto tree.c (tree_int_cst_equal). It returns
TRUE if the value of e1 is the same as e2.
*)
EXTERN tree m2expr_BuildAddAddress (location_t location, tree op1, tree op2);
EXTERN tree m2expr_BuildRDiv (location_t location, tree op1, tree op2,
bool needconvert);
+EXTERN int m2expr_GetCstInteger (tree cst);
EXTERN void m2expr_init (location_t location);
--- /dev/null
+MODULE addcharconst ;
+
+FROM libc IMPORT printf, exit ;
+FROM StrLib IMPORT StrLen ;
+
+
+PROCEDURE input (a: ARRAY OF CHAR) ;
+BEGIN
+ IF StrLen (a) # 2
+ THEN
+ printf ("string length is not 2, but %d\n", StrLen (a)) ;
+ exit (1)
+ END
+END input ;
+
+
+BEGIN
+ input (015C + 012C) ;
+ printf ("successful test, finishing\n")
+END addcharconst.
--- /dev/null
+MODULE singlechar ;
+
+FROM libc IMPORT printf, exit ;
+FROM StrLib IMPORT StrLen ;
+
+
+PROCEDURE input (a: ARRAY OF CHAR) ;
+BEGIN
+ IF StrLen (a) # 1
+ THEN
+ printf ("string length is not 1, but %d\n", StrLen (a)) ;
+ exit (1)
+ END
+END input ;
+
+
+BEGIN
+ input (015C) ;
+ printf ("successful test, finishing\n")
+END singlechar.
projects / platform / upstream / gcc.git / commitdiff