From: Gaius Mulley Date: Thu, 13 Apr 2023 16:02:48 +0000 (+0100) Subject: PR modula2/109496 Fix constant char parameter passing to an array of char X-Git-Tag: upstream/13.1.0~76 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=a1afdc6e2aa77d0a990e1a82aceeffc837b7e50c;p=platform%2Fupstream%2Fgcc.git PR modula2/109496 Fix constant char parameter passing to an array of char This patch fixes PR modula2/109496 and PR modula2/109497. The fix for PR modula2/109496 promotes a char constant to a string. The PR modula2/109497 allows for constant chars to be added to form a string. The fixes for both PR's occur in M2GenGCC.mod and M2GCCDeclare.mod after the resolving of constant declarations. gcc/m2/ChangeLog: * gm2-compiler/M2ALU.def (PopChar): New procedure function. * gm2-compiler/M2ALU.mod (PopChar): New procedure function. * gm2-compiler/M2GCCDeclare.mod (PromoteToString): Detect a single constant char and build a C string. * gm2-compiler/M2GenGCC.mod (IsConstStr): New procedure function. (GetStr): New procedure function. (FoldAdd): Use IsConstStr. * gm2-compiler/M2Quads.mod: Formatting changes. * gm2-gcc/m2expr.cc (m2expr_GetCstInteger): New function. * gm2-gcc/m2expr.def (GetCstInteger): New procedure function. * gm2-gcc/m2expr.h (m2expr_GetCstInteger): New prototype. gcc/testsuite/ChangeLog: PR modula2/109497 * gm2/pim/run/pass/addcharconst.mod: New test. PR modula2/109496 * gm2/pim/run/pass/singlechar.mod: New test. Signed-off-by: Gaius Mulley --- diff --git a/gcc/m2/gm2-compiler/M2ALU.def b/gcc/m2/gm2-compiler/M2ALU.def index e422211..91e4c24 100644 --- a/gcc/m2/gm2-compiler/M2ALU.def +++ b/gcc/m2/gm2-compiler/M2ALU.def @@ -51,6 +51,7 @@ EXPORT QUALIFIED PtrToValue, PushRealTree, PopRealTree, PushComplexTree, PopComplexTree, PopConstructorTree, + PopChar, PushCard, PushInt, PushChar, @@ -261,6 +262,13 @@ PROCEDURE PushChar (c: CHAR) ; (* + 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. *) diff --git a/gcc/m2/gm2-compiler/M2ALU.mod b/gcc/m2/gm2-compiler/M2ALU.mod index 324d6a7..caa66fc 100644 --- a/gcc/m2/gm2-compiler/M2ALU.mod +++ b/gcc/m2/gm2-compiler/M2ALU.mod @@ -67,7 +67,8 @@ FROM m2expr IMPORT BuildAdd, BuildSub, BuildMult, 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 ; @@ -1158,6 +1159,30 @@ END PushChar ; (* + 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. *) diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod index 8dceaae..5c171f7 100644 --- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod +++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod @@ -47,7 +47,7 @@ FROM M2AsmUtil IMPORT GetFullSymName, GetFullScopeAsmName ; 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 ; @@ -143,6 +143,7 @@ FROM M2Scope IMPORT ScopeBlock, InitScopeBlock, KillScopeBlock, ForeachScopeBloc 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 ; @@ -1562,16 +1563,24 @@ END DeclareStringConstant ; 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 ; diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod index 445c68e..1f593cf 100644 --- a/gcc/m2/gm2-compiler/M2GenGCC.mod +++ b/gcc/m2/gm2-compiler/M2GenGCC.mod @@ -109,7 +109,8 @@ FROM M2Bitset IMPORT Bitset ; 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 ; @@ -132,7 +133,7 @@ FROM M2ALU IMPORT PtrToValue, PushSetTree, PopSetTree, PopRealTree, PushCard, PushRealTree, - PopComplexTree, + PopComplexTree, PopChar, Gre, Sub, Equ, NotEqu, LessEqu, BuildRange, SetOr, SetAnd, SetNegate, SetSymmetricDifference, SetDifference, @@ -3590,6 +3591,38 @@ END BinaryOperands ; (* + 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. *) @@ -3598,18 +3631,17 @@ PROCEDURE FoldAdd (tokenno: CARDINAL; p: WalkAction; 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 @@ -5675,11 +5707,11 @@ VAR 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)) diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index df3e23f..2380efb 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -585,7 +585,7 @@ BEGIN END END ; - i := GetNextQuad(i) + i := GetNextQuad (i) END ; InternalError ('fix this for the sake of efficiency..') END IsBackReference ; @@ -686,7 +686,7 @@ BEGIN END END ; - i := GetNextQuad(i) + i := GetNextQuad (i) END ; InternalError ('fix this for the sake of efficiency..') END IsBackReferenceConditional ; diff --git a/gcc/m2/gm2-gcc/m2expr.cc b/gcc/m2/gm2-gcc/m2expr.cc index ef8368a..a319960 100644 --- a/gcc/m2/gm2-gcc/m2expr.cc +++ b/gcc/m2/gm2-gcc/m2expr.cc @@ -4283,6 +4283,16 @@ build_set_full_complement (location_t location) 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 diff --git a/gcc/m2/gm2-gcc/m2expr.def b/gcc/m2/gm2-gcc/m2expr.def index c43f020..cc80ded 100644 --- a/gcc/m2/gm2-gcc/m2expr.def +++ b/gcc/m2/gm2-gcc/m2expr.def @@ -584,6 +584,13 @@ PROCEDURE IsFalse (t: Tree) : BOOLEAN ; (* + 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. *) diff --git a/gcc/m2/gm2-gcc/m2expr.h b/gcc/m2/gm2-gcc/m2expr.h index 3701bcd..86e3bab 100644 --- a/gcc/m2/gm2-gcc/m2expr.h +++ b/gcc/m2/gm2-gcc/m2expr.h @@ -234,6 +234,7 @@ EXTERN void m2expr_ConstantExpressionWarning (tree value); 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); diff --git a/gcc/testsuite/gm2/pim/run/pass/addcharconst.mod b/gcc/testsuite/gm2/pim/run/pass/addcharconst.mod new file mode 100644 index 0000000..527a304 --- /dev/null +++ b/gcc/testsuite/gm2/pim/run/pass/addcharconst.mod @@ -0,0 +1,20 @@ +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. diff --git a/gcc/testsuite/gm2/pim/run/pass/singlechar.mod b/gcc/testsuite/gm2/pim/run/pass/singlechar.mod new file mode 100644 index 0000000..992049d --- /dev/null +++ b/gcc/testsuite/gm2/pim/run/pass/singlechar.mod @@ -0,0 +1,20 @@ +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.