diff options
Diffstat (limited to 'gcc/m2')
| -rw-r--r-- | gcc/m2/ChangeLog | 72 | ||||
| -rw-r--r-- | gcc/m2/gm2-compiler/M2GCCDeclare.def | 2 | ||||
| -rw-r--r-- | gcc/m2/gm2-compiler/M2GCCDeclare.mod | 6 | ||||
| -rw-r--r-- | gcc/m2/gm2-compiler/M2GenGCC.mod | 51 | ||||
| -rw-r--r-- | gcc/m2/gm2-compiler/M2Quads.mod | 107 | ||||
| -rw-r--r-- | gcc/m2/gm2-compiler/M2Range.mod | 2 | ||||
| -rw-r--r-- | gcc/m2/gm2-compiler/M2System.mod | 123 | ||||
| -rw-r--r-- | gcc/m2/gm2-gcc/m2builtins.cc | 22 | ||||
| -rw-r--r-- | gcc/m2/gm2-gcc/m2builtins.def | 13 | ||||
| -rw-r--r-- | gcc/m2/gm2-gcc/m2builtins.h | 2 | ||||
| -rw-r--r-- | gcc/m2/gm2-gcc/m2pp.cc | 1 | ||||
| -rw-r--r-- | gcc/m2/gm2-gcc/m2statement.cc | 115 | ||||
| -rw-r--r-- | gcc/m2/gm2-gcc/m2statement.def | 12 | ||||
| -rw-r--r-- | gcc/m2/gm2-gcc/m2statement.h | 1 | ||||
| -rw-r--r-- | gcc/m2/gm2-gcc/m2type.cc | 89 | ||||
| -rw-r--r-- | gcc/m2/gm2-gcc/m2type.def | 8 | ||||
| -rw-r--r-- | gcc/m2/gm2-gcc/m2type.h | 4 | ||||
| -rw-r--r-- | gcc/m2/lang.opt.urls | 2 |
18 files changed, 512 insertions, 120 deletions
diff --git a/gcc/m2/ChangeLog b/gcc/m2/ChangeLog index 694b062..234578d 100644 --- a/gcc/m2/ChangeLog +++ b/gcc/m2/ChangeLog @@ -1,3 +1,75 @@ +2025-03-30 Sandra Loosemore <sloosemore@baylibre.com> + + * lang.opt.urls: Regenerate. + +2025-03-28 Gaius Mulley <gaiusmod2@gmail.com> + + PR modula2/119504 + * gm2-compiler/M2Quads.mod (BuildHighFunction): Defend against + Type = NulSym and fall into BuildConstHighFromSym. + (BuildDesignatorArray): Rewrite to detect an array access to + a constant string. + (BuildDesignatorArrayStaticDynamic): New procedure. + +2025-03-25 Gaius Mulley <gaiusmod2@gmail.com> + + PR modula2/119449 + * gm2-compiler/M2GCCDeclare.def (TryDeclareType): Remove tokenno + parameter. + * gm2-compiler/M2GCCDeclare.mod (TryDeclareType): Ditto. + * gm2-compiler/M2GenGCC.mod (FoldTBitsize): Remove op2 and + rename op1 as res and op3 as type. + (FoldStandardFunction): Call FoldTBitsize omitting op2. + * gm2-compiler/M2Quads.mod (GetTypeMin): Rewrite. + (GetTypeMinLower): New procedure function. + (GetTypeMax): Rewrite. + (GetTypeMaxLower): New procedure function. + * gm2-compiler/M2Range.mod (CheckCancelled): Comment out. + * gm2-compiler/M2System.mod (CreateMinMaxFor): Add realtype + parameter. + (MapType): Rewrite to use realtype. + (CreateType): Ditto. + (AttemptToCreateType): Ditto. + (MakeFixedSizedTypes): Add realtype boolean. + (InitPIMTypes): Ditto. + (InitISOTypes): Ditto. + (MakeExtraSystemTypes): Ditto. + * gm2-gcc/m2pp.cc (m2pp_nop_expr): Remove code. + * gm2-gcc/m2type.cc (IsGccRealType): New function. + (m2type_GetMinFrom): Rewrite. + (m2type_GetMaxFrom): Ditto. + (do_min_real): Declare static. + (do_max_real): Declare static. + +2025-03-20 Gaius Mulley <gaiusmod2@gmail.com> + + PR modula2/118600 + * gm2-compiler/M2GenGCC.mod (PerformCodeBecomes): New procedure. + (CodeBecomes): Refactor and call PerformCodeBecomes. + * gm2-gcc/m2builtins.cc (gm2_strncpy_node): New global variable. + (DoBuiltinStrNCopy): New function. + (m2builtins_BuiltinStrNCopy): New function. + (m2builtins_init): Initialize gm2_strncpy_node. + * gm2-gcc/m2builtins.def (BuiltinStrNCopy): New procedure + function. + * gm2-gcc/m2builtins.h (m2builtins_BuiltinStrNCopy): New + function. + * gm2-gcc/m2statement.cc (copy_record_fields): New function. + (copy_array): Ditto. + (copy_strncpy): Ditto. + (copy_memcpy): Ditto. + (CopyByField_Lower): Ditto. + (m2statement_CopyByField): Ditto. + * gm2-gcc/m2statement.def (CopyByField): New procedure function. + * gm2-gcc/m2statement.h (m2statement_CopyByField): New function. + * gm2-gcc/m2type.cc (check_record_fields): Ditto. + (check_array_types): Ditto. + (m2type_IsGccStrictTypeEquivalent): Ditto. + * gm2-gcc/m2type.def (IsGccStrictTypeEquivalent): New procedure + function. + * gm2-gcc/m2type.h (m2type_IsAddress): Replace return type int + with bool. + 2025-03-16 Gaius Mulley <gaiusmod2@gmail.com> PR modula2/115111 diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.def b/gcc/m2/gm2-compiler/M2GCCDeclare.def index 1d87d6b..b3a5790 100644 --- a/gcc/m2/gm2-compiler/M2GCCDeclare.def +++ b/gcc/m2/gm2-compiler/M2GCCDeclare.def @@ -98,7 +98,7 @@ PROCEDURE TryDeclareConstant (tokenno: CARDINAL; sym: CARDINAL) ; then enter it into the to do list. *) -PROCEDURE TryDeclareType (tokenno: CARDINAL; type: CARDINAL) ; +PROCEDURE TryDeclareType (type: CARDINAL) ; (* diff --git a/gcc/m2/gm2-compiler/M2GCCDeclare.mod b/gcc/m2/gm2-compiler/M2GCCDeclare.mod index 7dcf439..b12add6 100644 --- a/gcc/m2/gm2-compiler/M2GCCDeclare.mod +++ b/gcc/m2/gm2-compiler/M2GCCDeclare.mod @@ -144,7 +144,7 @@ FROM M2Base IMPORT IsPseudoBaseProcedure, IsPseudoBaseFunction, Boolean, True, False, Nil, IsRealType, IsNeededAtRunTime, IsComplexType ; -FROM M2System IMPORT IsPseudoSystemFunction, IsSystemType, +FROM M2System IMPORT IsPseudoSystemFunction, IsSystemType, IsRealN, GetSystemTypeMinMax, Address, Word, Byte, Loc, System, IntegerN, CardinalN, WordN, RealN, SetN, ComplexN, CSizeT, CSSizeT, COffT ; @@ -1918,7 +1918,7 @@ END IsAnyType ; then enter it into the to do list. *) -PROCEDURE TryDeclareType (tokenno: CARDINAL; type: CARDINAL) ; +PROCEDURE TryDeclareType (type: CARDINAL) ; BEGIN IF (type#NulSym) AND IsAnyType (type) THEN @@ -2013,7 +2013,7 @@ BEGIN ELSIF IsConstructor(sym) THEN DeclareConstantFromTree(sym, PopConstructorTree(tokenno)) - ELSIF IsRealType(GetDType(sym)) + ELSIF IsRealType (GetDType (sym)) OR IsRealN (GetDType (sym)) THEN type := GetDType(sym) ; DeclareConstantFromTree(sym, BuildConvert(TokenToLocation(tokenno), Mod2Gcc(type), PopRealTree(), TRUE)) diff --git a/gcc/m2/gm2-compiler/M2GenGCC.mod b/gcc/m2/gm2-compiler/M2GenGCC.mod index ec38dc2..a1e3c07 100644 --- a/gcc/m2/gm2-compiler/M2GenGCC.mod +++ b/gcc/m2/gm2-compiler/M2GenGCC.mod @@ -43,7 +43,7 @@ FROM SymbolTable IMPORT PushSize, PopSize, PushValue, PopValue, IsConst, IsConstSet, IsProcedure, IsProcType, IsVar, IsVarParamAny, IsTemporary, IsTuple, IsEnumeration, - IsUnbounded, IsArray, IsSet, IsConstructor, + IsUnbounded, IsArray, IsSet, IsConstructor, IsConstructorConstant, IsProcedureVariable, IsUnboundedParamAny, IsRecordField, IsFieldVarient, IsVarient, IsRecord, @@ -232,7 +232,7 @@ FROM m2statement IMPORT BuildAsm, BuildProcedureCallTree, BuildParam, BuildFunct BuildReturnValueCode, SetLastFunction, BuildIncludeVarConst, BuildIncludeVarVar, BuildExcludeVarConst, BuildExcludeVarVar, - BuildBuiltinCallTree, + BuildBuiltinCallTree, CopyByField, GetParamTree, BuildCleanUp, BuildTryFinally, GetLastFunction, SetLastFunction, @@ -241,7 +241,7 @@ FROM m2statement IMPORT BuildAsm, BuildProcedureCallTree, BuildParam, BuildFunct FROM m2type IMPORT ChainOnParamValue, GetPointerType, GetIntegerType, AddStatement, GetCardinalType, GetWordType, GetM2ZType, GetM2RType, GetM2CType, BuildCharConstant, AddStringToTreeList, BuildArrayStringConstructor, - GetArrayNoOfElements, GetTreeType ; + GetArrayNoOfElements, GetTreeType, IsGccStrictTypeEquivalent ; FROM m2block IMPORT RememberConstant, pushGlobalScope, popGlobalScope, finishFunctionDecl, pushFunctionScope, popFunctionScope, @@ -3498,6 +3498,29 @@ END checkDeclare ; (* + PerformCodeBecomes - +*) + +PROCEDURE PerformCodeBecomes (location: location_t; + virtpos: CARDINAL; des, expr: CARDINAL) ; +VAR + destree, exprtree: tree ; +BEGIN + destree := Mod2Gcc (des) ; + exprtree := FoldConstBecomes (virtpos, des, expr) ; + IF IsVar (des) AND IsVariableSSA (des) + THEN + Replace (des, exprtree) + ELSIF IsGccStrictTypeEquivalent (destree, exprtree) + THEN + BuildAssignmentStatement (location, destree, exprtree) + ELSE + CopyByField (location, destree, exprtree) + END +END PerformCodeBecomes ; + + +(* ------------------------------------------------------------------------------ := Operator ------------------------------------------------------------------------------ @@ -3576,14 +3599,7 @@ BEGIN ELSE IF checkBecomes (des, expr, virtpos, despos, exprpos) THEN - IF IsVar (des) AND IsVariableSSA (des) - THEN - Replace (des, FoldConstBecomes (virtpos, des, expr)) - ELSE - BuildAssignmentStatement (location, - Mod2Gcc (des), - FoldConstBecomes (virtpos, des, expr)) - END + PerformCodeBecomes (location, virtpos, des, expr) ELSE SubQuad (quad) (* We don't want multiple errors for the quad. *) END @@ -4821,18 +4837,17 @@ END FoldBuiltinTypeInfo ; PROCEDURE FoldTBitsize (tokenno: CARDINAL; p: WalkAction; quad: CARDINAL; - op1, op2, op3: CARDINAL) ; + res, type: CARDINAL) ; VAR - type : CARDINAL ; location: location_t ; BEGIN location := TokenToLocation(tokenno) ; - TryDeclareType (tokenno, op3) ; - type := GetDType (op3) ; + TryDeclareType (type) ; + type := GetDType (type) ; IF CompletelyResolved (type) THEN - AddModGcc (op1, BuildSystemTBitSize (location, Mod2Gcc (type))) ; - p (op1) ; + AddModGcc (res, BuildSystemTBitSize (location, Mod2Gcc (type))) ; + p (res) ; NoChange := FALSE ; SubQuad (quad) END @@ -4971,7 +4986,7 @@ BEGIN END ELSIF op2=TBitSize THEN - FoldTBitsize (tokenno, p, quad, op1, op2, op3) + FoldTBitsize (tokenno, p, quad, op1, op3) ELSE InternalError ('only expecting LENGTH, CAP, ABS, IM, RE') END diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index a45d67a..9bb8c4d 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -8474,7 +8474,7 @@ BEGIN THEN (* we cannot test for IsConst(Param) AND (GetSType(Param)=Char) as the type might not be assigned yet *) MetaError1 ('base procedure {%EkHIGH} expects a variable or string constant as its parameter {%1d:rather than {%1d}} {%1asa}', Param) - ELSIF IsUnbounded(Type) + ELSIF (Type # NulSym) AND IsUnbounded(Type) THEN BuildHighFromUnbounded (combinedtok) ELSE @@ -9776,11 +9776,30 @@ END CheckBaseTypeValue ; (* - GetTypeMin - returns the minimium value of type. + GetTypeMin - returns the minimium value of type and generate an error + if this is unavailable. *) PROCEDURE GetTypeMin (tok: CARDINAL; func, type: CARDINAL) : CARDINAL ; VAR + min: CARDINAL ; +BEGIN + min := GetTypeMinLower (tok, func, type) ; + IF min = NulSym + THEN + MetaErrorT1 (tok, + 'unable to obtain the {%AkMIN} value for type {%1ad}', type) + END ; + RETURN min +END GetTypeMin ; + + +(* + GetTypeMinLower - obtain the maximum value for type. +*) + +PROCEDURE GetTypeMinLower (tok: CARDINAL; func, type: CARDINAL) : CARDINAL ; +VAR min, max: CARDINAL ; BEGIN IF IsSubrange (type) @@ -9803,22 +9822,38 @@ BEGIN RETURN min ELSIF GetSType (type) = NulSym THEN - MetaErrorT1 (tok, - 'unable to obtain the {%AkMIN} value for type {%1ad}', type) ; - (* non recoverable error. *) - InternalError ('MetaErrorT1 {%AkMIN} should call abort') + RETURN NulSym ELSE RETURN GetTypeMin (tok, func, GetSType (type)) END -END GetTypeMin ; +END GetTypeMinLower ; (* - GetTypeMax - returns the maximum value of type. + GetTypeMax - returns the maximum value of type and generate an error + if this is unavailable. *) PROCEDURE GetTypeMax (tok: CARDINAL; func, type: CARDINAL) : CARDINAL ; VAR + max: CARDINAL ; +BEGIN + max := GetTypeMaxLower (tok, func, type) ; + IF max = NulSym + THEN + MetaErrorT1 (tok, + 'unable to obtain the {%AkMAX} value for type {%1ad}', type) + END ; + RETURN max +END GetTypeMax ; + + +(* + GetTypeMaxLower - obtain the maximum value for type. +*) + +PROCEDURE GetTypeMaxLower (tok: CARDINAL; func, type: CARDINAL) : CARDINAL ; +VAR min, max: CARDINAL ; BEGIN IF IsSubrange (type) @@ -9841,14 +9876,11 @@ BEGIN RETURN max ELSIF GetSType (type) = NulSym THEN - MetaErrorT1 (tok, - 'unable to obtain the {%AkMAX} value for type {%1ad}', type) ; - (* non recoverable error. *) - InternalError ('MetaErrorT1 {%AkMAX} should call abort') + RETURN NulSym ELSE RETURN GetTypeMax (tok, func, GetSType (type)) END -END GetTypeMax ; +END GetTypeMaxLower ; (* @@ -11449,13 +11481,12 @@ END BuildDesignatorPointerError ; (* BuildDesignatorArray - Builds the array referencing. The purpose of this procedure is to work out - whether the DesignatorArray is a static or - dynamic array and to call the appropriate + whether the DesignatorArray is a constant string or + dynamic array/static array and to call the appropriate BuildRoutine. The Stack is expected to contain: - Entry Exit ===== ==== @@ -11468,6 +11499,41 @@ END BuildDesignatorPointerError ; *) PROCEDURE BuildDesignatorArray ; +BEGIN + IF IsConst (OperandT (2)) AND IsConstString (OperandT (2)) + THEN + MetaErrorT1 (OperandTtok (2), + '{%1Ead} is not an array, but a constant string. Hint use a string constant created with an array constructor', + OperandT (2)) ; + BuildDesignatorError ('bad array access') + ELSE + BuildDesignatorArrayStaticDynamic + END +END BuildDesignatorArray ; + + +(* + BuildDesignatorArrayStaticDynamic - Builds the array referencing. + The purpose of this procedure is to work out + whether the DesignatorArray is a static or + dynamic array and to call the appropriate + BuildRoutine. + + The Stack is expected to contain: + + + Entry Exit + ===== ==== + + Ptr -> + +--------------+ + | e | <- Ptr + |--------------| +------------+ + | Sym | Type | | S | T | + |--------------| |------------| +*) + +PROCEDURE BuildDesignatorArrayStaticDynamic ; VAR combinedTok, arrayTok, @@ -11480,10 +11546,7 @@ BEGIN IF IsConst (OperandT (2)) THEN type := GetDType (OperandT (2)) ; - IF type = NulSym - THEN - InternalError ('constant type should have been resolved') - ELSIF IsArray (type) + IF (type # NulSym) AND IsArray (type) THEN PopTtok (e, exprTok) ; PopTFDtok (Sym, Type, dim, arrayTok) ; @@ -11501,7 +11564,7 @@ BEGIN IF (NOT IsVar (OperandT (2))) AND (NOT IsTemporary (OperandT (2))) THEN MetaErrorT1 (OperandTtok (2), - 'can only access arrays using variables or formal parameters not {%1Ead}', + 'can only access arrays using constants, variables or formal parameters not {%1Ead}', OperandT (2)) ; BuildDesignatorError ('bad array access') END ; @@ -11528,7 +11591,7 @@ BEGIN Sym) ; BuildDesignatorError ('bad array access') END -END BuildDesignatorArray ; +END BuildDesignatorArrayStaticDynamic ; (* diff --git a/gcc/m2/gm2-compiler/M2Range.mod b/gcc/m2/gm2-compiler/M2Range.mod index 347012b..2a5bfab 100644 --- a/gcc/m2/gm2-compiler/M2Range.mod +++ b/gcc/m2/gm2-compiler/M2Range.mod @@ -1257,6 +1257,7 @@ END FoldAssignment ; CheckCancelled - check to see if the range has been cancelled and if so remove quad. *) +(* PROCEDURE CheckCancelled (range: CARDINAL; quad: CARDINAL) ; BEGIN IF IsCancelled (range) @@ -1264,6 +1265,7 @@ BEGIN SubQuad (quad) END END CheckCancelled ; +*) (* diff --git a/gcc/m2/gm2-compiler/M2System.mod b/gcc/m2/gm2-compiler/M2System.mod index efd5d11..68ed9dc 100644 --- a/gcc/m2/gm2-compiler/M2System.mod +++ b/gcc/m2/gm2-compiler/M2System.mod @@ -61,7 +61,7 @@ FROM NameKey IMPORT Name, MakeKey, NulName ; FROM M2Batch IMPORT MakeDefinitionSource ; FROM M2Base IMPORT Cardinal, ZType ; FROM M2Size IMPORT Size, MakeSize ; -FROM M2ALU IMPORT PushCard, PushIntegerTree, DivTrunc ; +FROM M2ALU IMPORT PushCard, PushIntegerTree, PushRealTree, DivTrunc ; FROM M2Error IMPORT InternalError ; FROM Lists IMPORT List, InitList, IsItemInList, PutItemIntoList, GetItemFromList, NoOfItemsInList ; FROM SymbolKey IMPORT SymbolTree, InitTree, GetSymKey, PutSymKey ; @@ -114,21 +114,32 @@ END Init ; (* - CreateMinMaxFor - creates the min and max values for, type, given gccType. + CreateMinMaxFor - creates the min and max values for type given gccType. *) -PROCEDURE CreateMinMaxFor (type: CARDINAL; min, max: ARRAY OF CHAR; gccType: tree) ; +PROCEDURE CreateMinMaxFor (type: CARDINAL; min, max: ARRAY OF CHAR; + gccType: tree; realtype: BOOLEAN) ; VAR maxval, minval: CARDINAL ; BEGIN maxval := MakeConstVar (BuiltinTokenNo, MakeKey(max)) ; - PushIntegerTree (GetMaxFrom (BuiltinsLocation (), gccType)) ; + IF realtype + THEN + PushRealTree (GetMaxFrom (BuiltinsLocation (), gccType)) + ELSE + PushIntegerTree (GetMaxFrom (BuiltinsLocation (), gccType)) + END ; PopValue (maxval) ; PutVar (maxval, type) ; PutSymKey (MaxValues, GetSymName (type), maxval) ; minval := MakeConstVar (BuiltinTokenNo, MakeKey(min)) ; - PushIntegerTree (GetMinFrom (BuiltinsLocation (), gccType)) ; + IF realtype + THEN + PushRealTree (GetMinFrom (BuiltinsLocation (), gccType)) + ELSE + PushIntegerTree (GetMinFrom (BuiltinsLocation (), gccType)) + END ; PopValue (minval) ; PutVar (minval, type) ; PutSymKey (MinValues, GetSymName (type), minval) @@ -136,31 +147,32 @@ END CreateMinMaxFor ; (* - MapType - + MapType - create a mapping of the M2 frontend type to gcctype. *) PROCEDURE MapType (type: CARDINAL; name, min, max: ARRAY OF CHAR; - needsExporting: BOOLEAN; t: tree) ; + needsExporting: BOOLEAN; + gcctype: tree; realtype: BOOLEAN) ; VAR n: Name ; BEGIN - PushIntegerTree(BuildSize(BuiltinsLocation(), t, FALSE)) ; - PopSize(type) ; - IF IsItemInList(SystemTypes, type) + PushIntegerTree (BuildSize (BuiltinsLocation (), gcctype, FALSE)) ; + PopSize (type) ; + IF IsItemInList (SystemTypes, type) THEN InternalError ('not expecting system type to already be declared') END ; - PutItemIntoList(SystemTypes, type) ; + PutItemIntoList (SystemTypes, type) ; - (* create min, max constants if type is ordinal *) - IF (NOT StrEqual(min, '')) AND (NOT StrEqual(max, '')) + (* Create min, max constants if type is ordinal or a floating point type. *) + IF (NOT StrEqual (min, '')) AND (NOT StrEqual (max, '')) THEN - CreateMinMaxFor(type, min, max, t) + CreateMinMaxFor (type, min, max, gcctype, realtype) END ; IF needsExporting AND DumpSystemExports THEN - n := GetSymName(type) ; + n := GetSymName (type) ; printf1('SYSTEM module creates type: %a\n', n) END END MapType ; @@ -171,7 +183,8 @@ END MapType ; *) PROCEDURE CreateType (name, min, max: ARRAY OF CHAR; - needsExporting: BOOLEAN; gccType: tree) : CARDINAL ; + needsExporting: BOOLEAN; gccType: tree; + realtype: BOOLEAN) : CARDINAL ; VAR type: CARDINAL ; BEGIN @@ -183,7 +196,7 @@ BEGIN (* Create base type. *) type := MakeType (BuiltinTokenNo, MakeKey (name)) ; PutType (type, NulSym) ; (* a Base Type *) - MapType (type, name, min, max, needsExporting, gccType) ; + MapType (type, name, min, max, needsExporting, gccType, realtype) ; RETURN type END END CreateType ; @@ -195,9 +208,11 @@ END CreateType ; *) PROCEDURE AttemptToCreateType (name, min, max: ARRAY OF CHAR; - needsExporting: BOOLEAN; gccType: tree) ; + needsExporting: BOOLEAN; gccType: tree; + realtype: BOOLEAN) ; BEGIN - Assert (IsLegal (CreateType (name, min, max, needsExporting, gccType))) + Assert (IsLegal (CreateType (name, min, max, needsExporting, + gccType, realtype))) END AttemptToCreateType ; @@ -226,7 +241,7 @@ BEGIN subrange := MakeSubrange (BuiltinTokenNo, NulName) ; PutSubrange (subrange, low, high, Cardinal) ; PutSet (type, subrange, FALSE) ; - MapType (type, name, '', '', needsExporting, gccType) ; + MapType (type, name, '', '', needsExporting, gccType, FALSE) ; RETURN type END END CreateSetType ; @@ -251,33 +266,33 @@ END AttemptToCreateSetType ; PROCEDURE MakeFixedSizedTypes ; BEGIN - AttemptToCreateType ('INTEGER8', 'MinInteger8', 'MaxInteger8', TRUE, GetM2Integer8 ()) ; - AttemptToCreateType ('INTEGER16', 'MinInteger16', 'MaxInteger16', TRUE, GetM2Integer16 ()) ; - AttemptToCreateType ('INTEGER32', 'MinInteger32', 'MaxInteger32', TRUE, GetM2Integer32 ()) ; - AttemptToCreateType ('INTEGER64', 'MinInteger64', 'MaxInteger64', TRUE, GetM2Integer64 ()) ; + AttemptToCreateType ('INTEGER8', 'MinInteger8', 'MaxInteger8', TRUE, GetM2Integer8 (), FALSE) ; + AttemptToCreateType ('INTEGER16', 'MinInteger16', 'MaxInteger16', TRUE, GetM2Integer16 (), FALSE) ; + AttemptToCreateType ('INTEGER32', 'MinInteger32', 'MaxInteger32', TRUE, GetM2Integer32 (), FALSE) ; + AttemptToCreateType ('INTEGER64', 'MinInteger64', 'MaxInteger64', TRUE, GetM2Integer64 (), FALSE) ; - AttemptToCreateType ('CARDINAL8', 'MinCardinal8', 'MaxCardinal8', TRUE, GetM2Cardinal8 ()) ; - AttemptToCreateType ('CARDINAL16', 'MinCardinal16', 'MaxCardinal16', TRUE, GetM2Cardinal16 ()) ; - AttemptToCreateType ('CARDINAL32', 'MinCardinal32', 'MaxCardinal32', TRUE, GetM2Cardinal32 ()) ; - AttemptToCreateType ('CARDINAL64', 'MinCardinal64', 'MaxCardinal64', TRUE, GetM2Cardinal64 ()) ; + AttemptToCreateType ('CARDINAL8', 'MinCardinal8', 'MaxCardinal8', TRUE, GetM2Cardinal8 (), FALSE) ; + AttemptToCreateType ('CARDINAL16', 'MinCardinal16', 'MaxCardinal16', TRUE, GetM2Cardinal16 (), FALSE) ; + AttemptToCreateType ('CARDINAL32', 'MinCardinal32', 'MaxCardinal32', TRUE, GetM2Cardinal32 (), FALSE) ; + AttemptToCreateType ('CARDINAL64', 'MinCardinal64', 'MaxCardinal64', TRUE, GetM2Cardinal64 (), FALSE) ; - AttemptToCreateType ('WORD16', '', '', TRUE, GetM2Word16 ()) ; - AttemptToCreateType ('WORD32', '', '', TRUE, GetM2Word32 ()) ; - AttemptToCreateType ('WORD64', '', '', TRUE, GetM2Word64 ()) ; + AttemptToCreateType ('WORD16', '', '', TRUE, GetM2Word16 (), FALSE) ; + AttemptToCreateType ('WORD32', '', '', TRUE, GetM2Word32 (), FALSE) ; + AttemptToCreateType ('WORD64', '', '', TRUE, GetM2Word64 (), FALSE) ; AttemptToCreateSetType ('BITSET8' , '7' , TRUE, GetM2Bitset8 ()) ; AttemptToCreateSetType ('BITSET16', '15', TRUE, GetM2Bitset16 ()) ; AttemptToCreateSetType ('BITSET32', '31', TRUE, GetM2Bitset32 ()) ; - AttemptToCreateType ('REAL32', '', '', TRUE, GetM2Real32 ()) ; - AttemptToCreateType ('REAL64', '', '', TRUE, GetM2Real64 ()) ; - AttemptToCreateType ('REAL96', '', '', TRUE, GetM2Real96 ()) ; - AttemptToCreateType ('REAL128', '', '', TRUE, GetM2Real128 ()) ; + AttemptToCreateType ('REAL32', 'MinReal32', 'MaxReal32', TRUE, GetM2Real32 (), TRUE) ; + AttemptToCreateType ('REAL64', 'MinReal64', 'MaxReal64', TRUE, GetM2Real64 (), TRUE) ; + AttemptToCreateType ('REAL96', 'MinReal96', 'MaxReal96', TRUE, GetM2Real96 (), TRUE) ; + AttemptToCreateType ('REAL128', 'MinReal128', 'MaxReal128', TRUE, GetM2Real128 (), TRUE) ; - AttemptToCreateType ('COMPLEX32', '', '', TRUE, GetM2Complex32 ()) ; - AttemptToCreateType ('COMPLEX64', '', '', TRUE, GetM2Complex64 ()) ; - AttemptToCreateType ('COMPLEX96', '', '', TRUE, GetM2Complex96 ()) ; - AttemptToCreateType ('COMPLEX128', '', '', TRUE, GetM2Complex128 ()) + AttemptToCreateType ('COMPLEX32', '', '', TRUE, GetM2Complex32 (), TRUE) ; + AttemptToCreateType ('COMPLEX64', '', '', TRUE, GetM2Complex64 (), TRUE) ; + AttemptToCreateType ('COMPLEX96', '', '', TRUE, GetM2Complex96 (), TRUE) ; + AttemptToCreateType ('COMPLEX128', '', '', TRUE, GetM2Complex128 (), TRUE) END MakeFixedSizedTypes ; @@ -287,16 +302,16 @@ END MakeFixedSizedTypes ; PROCEDURE InitPIMTypes ; BEGIN - Loc := CreateType ('LOC', '', '', TRUE, GetISOLocType()) ; + Loc := CreateType ('LOC', '', '', TRUE, GetISOLocType(), FALSE) ; InitSystemTypes(BuiltinsLocation(), Loc) ; - Word := CreateType ('WORD', '', '', TRUE, GetWordType()) ; - Byte := CreateType ('BYTE', '', '', TRUE, GetByteType()) ; + Word := CreateType ('WORD', '', '', TRUE, GetWordType(), FALSE) ; + Byte := CreateType ('BYTE', '', '', TRUE, GetByteType(), FALSE) ; (* ADDRESS = POINTER TO BYTE *) Address := MakePointer (BuiltinTokenNo, MakeKey('ADDRESS')) ; PutPointer (Address, Byte) ; (* Base Type *) - MapType (Address, 'ADDRESS', '', '', TRUE, GetPointerType()) + MapType (Address, 'ADDRESS', '', '', TRUE, GetPointerType(), FALSE) END InitPIMTypes ; @@ -306,17 +321,15 @@ END InitPIMTypes ; PROCEDURE InitISOTypes ; BEGIN - Loc := CreateType ('LOC', 'MinLoc', 'MaxLoc', TRUE, GetISOLocType ()) ; + Loc := CreateType ('LOC', 'MinLoc', 'MaxLoc', TRUE, GetISOLocType (), FALSE) ; InitSystemTypes (BuiltinsLocation (), Loc) ; Address := MakePointer (BuiltinTokenNo, MakeKey ('ADDRESS')) ; PutPointer (Address, Loc) ; (* Base Type *) - MapType (Address, 'ADDRESS', '', '', TRUE, GetPointerType()) ; - - Byte := CreateType ('BYTE', '', '', TRUE, GetISOByteType()) ; - Word := CreateType ('WORD', '', '', TRUE, GetISOWordType()) ; + MapType (Address, 'ADDRESS', '', '', TRUE, GetPointerType(), FALSE) ; - (* CreateMinMaxFor(Loc, 'MinLoc', 'MaxLoc', GetISOLocType()) *) + Byte := CreateType ('BYTE', '', '', TRUE, GetISOByteType(), FALSE) ; + Word := CreateType ('WORD', '', '', TRUE, GetISOWordType(), FALSE) ; END InitISOTypes ; @@ -327,9 +340,9 @@ END InitISOTypes ; PROCEDURE MakeExtraSystemTypes ; BEGIN - CSizeT := CreateType ('CSIZE_T' , '', '', TRUE, GetCSizeTType ()) ; - CSSizeT := CreateType ('CSSIZE_T', '', '', TRUE, GetCSSizeTType ()) ; - COffT := CreateType ('COFF_T', '', '', TRUE, GetCOffTType ()) ; + CSizeT := CreateType ('CSIZE_T' , '', '', TRUE, GetCSizeTType (), FALSE) ; + CSSizeT := CreateType ('CSSIZE_T', '', '', TRUE, GetCSSizeTType (), FALSE) ; + COffT := CreateType ('COFF_T', '', '', TRUE, GetCOffTType (), FALSE) END MakeExtraSystemTypes ; @@ -425,9 +438,9 @@ BEGIN MakeKey('THROW')) ; (* Procedure *) PutProcedureNoReturn (Throw, DefProcedure, TRUE) ; - CreateMinMaxFor(Word, 'MinWord', 'MaxWord', GetWordType()) ; - CreateMinMaxFor(Address, 'MinAddress', 'MaxAddress', GetPointerType()) ; - CreateMinMaxFor(Byte, 'MinByte', 'MaxByte', GetByteType()) ; + CreateMinMaxFor(Word, 'MinWord', 'MaxWord', GetWordType(), FALSE) ; + CreateMinMaxFor(Address, 'MinAddress', 'MaxAddress', GetPointerType(), FALSE) ; + CreateMinMaxFor(Byte, 'MinByte', 'MaxByte', GetByteType(), FALSE) ; MakeFixedSizedTypes ; MakeExtraSystemTypes ; diff --git a/gcc/m2/gm2-gcc/m2builtins.cc b/gcc/m2/gm2-gcc/m2builtins.cc index 175c62a..cb9ef65 100644 --- a/gcc/m2/gm2-gcc/m2builtins.cc +++ b/gcc/m2/gm2-gcc/m2builtins.cc @@ -418,6 +418,7 @@ static GTY (()) tree ldouble_ftype_ldouble; static GTY (()) tree gm2_alloca_node; static GTY (()) tree gm2_memcpy_node; static GTY (()) tree gm2_memset_node; +static GTY (()) tree gm2_strncpy_node; static GTY (()) tree gm2_isfinite_node; static GTY (()) tree gm2_isnan_node; static GTY (()) tree gm2_huge_valf_node; @@ -1040,6 +1041,18 @@ DoBuiltinMemCopy (location_t location, tree dest, tree src, tree bytes) } static tree +DoBuiltinStrNCopy (location_t location, tree dest, tree src, tree bytes) +{ + tree functype = TREE_TYPE (gm2_strncpy_node); + tree rettype = TREE_TYPE (functype); + tree funcptr + = build1 (ADDR_EXPR, build_pointer_type (functype), gm2_strncpy_node); + tree call + = m2treelib_DoCall3 (location, rettype, funcptr, dest, src, bytes); + return call; +} + +static tree DoBuiltinAlloca (location_t location, tree bytes) { tree functype = TREE_TYPE (gm2_alloca_node); @@ -1105,6 +1118,14 @@ m2builtins_BuiltInHugeValLong (location_t location) return call; } +/* BuiltinStrNCopy copy at most n chars from address src to dest. */ + +tree +m2builtins_BuiltinStrNCopy (location_t location, tree dest, tree src, tree n) +{ + return DoBuiltinStrNCopy (location, dest, src, n); +} + static void create_function_prototype (location_t location, struct builtin_function_entry *fe) @@ -1580,6 +1601,7 @@ m2builtins_init (location_t location) gm2_alloca_node = find_builtin_tree ("__builtin_alloca"); gm2_memcpy_node = find_builtin_tree ("__builtin_memcpy"); gm2_memset_node = find_builtin_tree ("__builtin_memset"); + gm2_strncpy_node = find_builtin_tree ("__builtin_strncpy"); gm2_huge_valf_node = find_builtin_tree ("__builtin_huge_valf"); gm2_huge_val_node = find_builtin_tree ("__builtin_huge_val"); gm2_huge_vall_node = find_builtin_tree ("__builtin_huge_vall"); diff --git a/gcc/m2/gm2-gcc/m2builtins.def b/gcc/m2/gm2-gcc/m2builtins.def index 61f769d..5ab5a6d 100644 --- a/gcc/m2/gm2-gcc/m2builtins.def +++ b/gcc/m2/gm2-gcc/m2builtins.def @@ -24,12 +24,6 @@ DEFINITION MODULE FOR "C" m2builtins ; FROM CDataTypes IMPORT CharStar, ConstCharStar ; FROM gcctypes IMPORT location_t, tree ; -EXPORT QUALIFIED GetBuiltinConst, GetBuiltinConstType, - GetBuiltinTypeInfoType, GetBuiltinTypeInfo, - BuiltinExists, BuildBuiltinTree, - BuiltinMemCopy, BuiltinMemSet, BuiltInAlloca, - BuiltInIsfinite ; - (* GetBuiltinConst - returns the gcc tree of a built in constant, name. @@ -124,4 +118,11 @@ PROCEDURE BuiltInAlloca (location: location_t; n: tree) : tree ; PROCEDURE BuiltInIsfinite (location: location_t; e: tree) : tree ; +(* + BuiltinStrNCopy - copy at most n characters from src to dest. +*) + +PROCEDURE BuiltinStrNCopy (location: location_t; dest, src, n: tree) : tree ; + + END m2builtins. diff --git a/gcc/m2/gm2-gcc/m2builtins.h b/gcc/m2/gm2-gcc/m2builtins.h index 37bdbfa..017d2df 100644 --- a/gcc/m2/gm2-gcc/m2builtins.h +++ b/gcc/m2/gm2-gcc/m2builtins.h @@ -54,6 +54,8 @@ EXTERN tree m2builtins_BuildBuiltinTree (location_t location, char *name); EXTERN tree m2builtins_BuiltInHugeVal (location_t location); EXTERN tree m2builtins_BuiltInHugeValShort (location_t location); EXTERN tree m2builtins_BuiltInHugeValLong (location_t location); +EXTERN tree m2builtins_BuiltinStrNCopy (location_t location, tree dest, tree src, tree n); + EXTERN void m2builtins_init (location_t location); #undef EXTERN diff --git a/gcc/m2/gm2-gcc/m2pp.cc b/gcc/m2/gm2-gcc/m2pp.cc index 6ec8aaa..7d4adb8 100644 --- a/gcc/m2/gm2-gcc/m2pp.cc +++ b/gcc/m2/gm2-gcc/m2pp.cc @@ -2367,7 +2367,6 @@ m2pp_asm_expr (pretty *state, tree node) static void m2pp_nop_expr (pretty *state, tree t) { - enum tree_code code = TREE_CODE (t); m2pp_begin (state); m2pp_print (state, "(* NOP for debug location *)"); m2pp_needspace (state); diff --git a/gcc/m2/gm2-gcc/m2statement.cc b/gcc/m2/gm2-gcc/m2statement.cc index d42183f..7952984 100644 --- a/gcc/m2/gm2-gcc/m2statement.cc +++ b/gcc/m2/gm2-gcc/m2statement.cc @@ -36,6 +36,7 @@ along with GNU Modula-2; see the file COPYING3. If not see #include "m2treelib.h" #include "m2type.h" #include "m2convert.h" +#include "m2builtins.h" #include "m2pp.h" static GTY (()) tree param_list = NULL_TREE; /* Ready for the next time we @@ -154,6 +155,120 @@ m2statement_SetEndLocation (location_t location) cfun->function_end_locus = location; } +/* copy_record_fields copy each record field from right to left. */ + +static +void +copy_record_fields (location_t location, tree left, tree right) +{ + unsigned int i; + tree right_value; + tree left_type = TREE_TYPE (left); + vec<constructor_elt, va_gc> *values = CONSTRUCTOR_ELTS (right); + FOR_EACH_CONSTRUCTOR_VALUE (values, i, right_value) + { + tree left_field = m2treelib_get_field_no (left_type, NULL_TREE, false, i); + tree left_ref = m2expr_BuildComponentRef (location, left, left_field); + m2statement_CopyByField (location, left_ref, right_value); + } +} + +/* copy_array copy each element of an array from array right to array left. */ + +static +void +copy_array (location_t location, tree left, tree right) +{ + unsigned int i; + tree value; + vec<constructor_elt, va_gc> *values = CONSTRUCTOR_ELTS (right); + tree array_type = TREE_TYPE (left); + tree index_type = TYPE_DOMAIN (array_type); + tree elt_type = TREE_TYPE (array_type); + tree low_indice = TYPE_MIN_VALUE (index_type); + low_indice + = m2convert_BuildConvert (location, index_type, low_indice, false); + FOR_EACH_CONSTRUCTOR_VALUE (values, i, value) + { + tree idx = m2decl_BuildIntegerConstant (i); + idx = m2convert_BuildConvert (location, index_type, idx, false); + tree array_ref = build4_loc (location, ARRAY_REF, elt_type, left, + idx, low_indice, NULL_TREE); + m2statement_CopyByField (location, array_ref, value); + } +} + +/* copy_array cst into left using strncpy. */ + +static +void +copy_strncpy (location_t location, tree left, tree cst) +{ + tree result = m2builtins_BuiltinStrNCopy (location, + m2expr_BuildAddr (location, left, false), + m2expr_BuildAddr (location, cst, false), + m2decl_BuildIntegerConstant (m2expr_StringLength (cst))); + TREE_SIDE_EFFECTS (result) = true; + TREE_USED (left) = true; + TREE_USED (cst) = true; + add_stmt (location, result); +} + +/* copy_memcpy copy right into left using builtin_memcpy. */ + +static +void +copy_memcpy (location_t location, tree left, tree right) +{ + tree result = m2builtins_BuiltinMemCopy (location, + m2expr_BuildAddr (location, left, false), + m2expr_BuildAddr (location, right, false), + m2expr_GetSizeOf (location, left)); + TREE_SIDE_EFFECTS (result) = true; + TREE_USED (left) = true; + TREE_USED (right) = true; + add_stmt (location, result); +} + +/* CopyByField_Lower copy right to left using memcpy for unions, + strncpy for string cst, field assignment for records, + array element assignment for array constructors. For all + other types it uses BuildAssignmentStatement. */ + +static +void +CopyByField_Lower (location_t location, + tree left, tree right) +{ + tree left_type = TREE_TYPE (left); + enum tree_code right_code = TREE_CODE (right); + enum tree_code left_code = TREE_CODE (left_type); + + if (left_code == RECORD_TYPE && right_code == CONSTRUCTOR) + copy_record_fields (location, left, right); + else if (left_code == ARRAY_TYPE && right_code == CONSTRUCTOR) + copy_array (location, left, right); + else if (left_code == UNION_TYPE && right_code == CONSTRUCTOR) + copy_memcpy (location, left, right); + else if (right_code == STRING_CST) + copy_strncpy (location, left, right); + else + m2statement_BuildAssignmentStatement (location, left, right); +} + +/* CopyByField recursively checks each field to ensure GCC + type equivalence and if so it uses assignment. + Otherwise use strncpy or memcpy depending upon type. */ + +void +m2statement_CopyByField (location_t location, tree des, tree expr) +{ + if (m2type_IsGccStrictTypeEquivalent (des, expr)) + m2statement_BuildAssignmentStatement (location, des, expr); + else + CopyByField_Lower (location, des, expr); +} + /* BuildAssignmentTree builds the assignment of, des, and, expr. It returns, des. */ diff --git a/gcc/m2/gm2-gcc/m2statement.def b/gcc/m2/gm2-gcc/m2statement.def index 074b768..ffaf697 100644 --- a/gcc/m2/gm2-gcc/m2statement.def +++ b/gcc/m2/gm2-gcc/m2statement.def @@ -314,4 +314,16 @@ PROCEDURE SetEndLocation (location: location_t) ; PROCEDURE BuildBuiltinCallTree (func: tree) : tree ; +(* + CopyByField - copy expr to des, if des is a record, union or an array + then check fields for GCC type equivalence and if necessary + call __builtin_strncpy and __builtin_memcpy. + This can occur if an expr contains a constant string + which is to be assigned into a field declared as + an ARRAY [0..n] OF CHAR. +*) + +PROCEDURE CopyByField (location: location_t; des, expr: tree) ; + + END m2statement. diff --git a/gcc/m2/gm2-gcc/m2statement.h b/gcc/m2/gm2-gcc/m2statement.h index db2daf3..0076b32 100644 --- a/gcc/m2/gm2-gcc/m2statement.h +++ b/gcc/m2/gm2-gcc/m2statement.h @@ -108,6 +108,7 @@ EXTERN tree m2statement_BuildBuiltinCallTree (tree func); EXTERN tree m2statement_BuildTryFinally (location_t location, tree call, tree cleanups); EXTERN tree m2statement_BuildCleanUp (tree param); +EXTERN void m2statement_CopyByField (location_t location, tree des, tree expr); #undef EXTERN #endif /* m2statement_h. */ diff --git a/gcc/m2/gm2-gcc/m2type.cc b/gcc/m2/gm2-gcc/m2type.cc index a946509..e486f12 100644 --- a/gcc/m2/gm2-gcc/m2type.cc +++ b/gcc/m2/gm2-gcc/m2type.cc @@ -1891,6 +1891,22 @@ m2type_GetDefaultType (location_t location, char *name, tree type) return id; } +/* IsGccRealType return true if type is a GCC realtype. */ + +static +bool +IsGccRealType (tree type) +{ + return (type == m2_real_type_node || type == m2type_GetRealType () || + type == m2_long_real_type_node || type == m2type_GetLongRealType () || + type == m2_short_real_type_node || type == m2type_GetShortRealType () || + type == m2type_GetM2Real32 () || + type == m2type_GetM2Real64 () || + type == m2type_GetM2Real96 () || + type == m2type_GetM2Real128 ()); +} + +static tree do_min_real (tree type) { @@ -1911,11 +1927,7 @@ m2type_GetMinFrom (location_t location, tree type) { m2assert_AssertLocation (location); - if (type == m2_real_type_node || type == m2type_GetRealType ()) - return do_min_real (type); - if (type == m2_long_real_type_node || type == m2type_GetLongRealType ()) - return do_min_real (type); - if (type == m2_short_real_type_node || type == m2type_GetShortRealType ()) + if (IsGccRealType (type)) return do_min_real (type); if (type == ptr_type_node) return m2expr_GetPointerZero (location); @@ -1923,6 +1935,7 @@ m2type_GetMinFrom (location_t location, tree type) return TYPE_MIN_VALUE (m2tree_skip_type_decl (type)); } +static tree do_max_real (tree type) { @@ -1943,11 +1956,7 @@ m2type_GetMaxFrom (location_t location, tree type) { m2assert_AssertLocation (location); - if (type == m2_real_type_node || type == m2type_GetRealType ()) - return do_max_real (type); - if (type == m2_long_real_type_node || type == m2type_GetLongRealType ()) - return do_max_real (type); - if (type == m2_short_real_type_node || type == m2type_GetShortRealType ()) + if (IsGccRealType (type)) return do_max_real (type); if (type == ptr_type_node) return fold (m2expr_BuildSub (location, m2expr_GetPointerZero (location), @@ -3105,10 +3114,68 @@ m2type_gm2_signed_or_unsigned_type (int unsignedp, tree type) /* IsAddress returns true if the type is an ADDRESS. */ -int +bool m2type_IsAddress (tree type) { return type == ptr_type_node; } +/* check_record_fields return true if all the fields in left and right + are GCC equivalent. */ + +static +bool +check_record_fields (tree left, tree right) +{ + unsigned int i; + tree right_value; + vec<constructor_elt, va_gc> *values = CONSTRUCTOR_ELTS (right); + FOR_EACH_CONSTRUCTOR_VALUE (values, i, right_value) + { + tree left_field = TREE_TYPE (m2treelib_get_field_no (left, NULL_TREE, false, i)); + if (! m2type_IsGccStrictTypeEquivalent (left_field, right_value)) + return false; + } + return true; +} + +/* check_array_types return true if left and right have the same type and right + is not a CST_STRING. */ + +static +bool +check_array_types (tree right) +{ + unsigned int i; + tree value; + vec<constructor_elt, va_gc> *values = CONSTRUCTOR_ELTS (right); + FOR_EACH_CONSTRUCTOR_VALUE (values, i, value) + { + enum tree_code right_code = TREE_CODE (value); + if (right_code == STRING_CST) + return false; + } + return true; +} + +bool +m2type_IsGccStrictTypeEquivalent (tree left, tree right) +{ + enum tree_code right_code = TREE_CODE (right); + enum tree_code left_code = TREE_CODE (left); + if (left_code == VAR_DECL) + return m2type_IsGccStrictTypeEquivalent (TREE_TYPE (left), right); + if (right_code == VAR_DECL) + return m2type_IsGccStrictTypeEquivalent (left, TREE_TYPE (right)); + if (left_code == RECORD_TYPE && right_code == CONSTRUCTOR) + return check_record_fields (left, right); + if (left_code == UNION_TYPE && right_code == CONSTRUCTOR) + return false; + if (left_code == ARRAY_TYPE && right_code == CONSTRUCTOR) + return check_array_types (right); + if (right_code == STRING_CST) + return false; + return true; +} + #include "gt-m2-m2type.h" diff --git a/gcc/m2/gm2-gcc/m2type.def b/gcc/m2/gm2-gcc/m2type.def index 797335e..f74888e 100644 --- a/gcc/m2/gm2-gcc/m2type.def +++ b/gcc/m2/gm2-gcc/m2type.def @@ -996,4 +996,12 @@ PROCEDURE IsAddress (type: tree) : BOOLEAN ; PROCEDURE SameRealType (a, b: tree) : BOOLEAN ; +(* + IsGccStrictTypeEquivalent - return true if left and right and + all their contents have the same type. +*) + +PROCEDURE IsGccStrictTypeEquivalent (left, right: tree) : BOOLEAN ; + + END m2type. diff --git a/gcc/m2/gm2-gcc/m2type.h b/gcc/m2/gm2-gcc/m2type.h index 04370d6..663af3c 100644 --- a/gcc/m2/gm2-gcc/m2type.h +++ b/gcc/m2/gm2-gcc/m2type.h @@ -210,10 +210,10 @@ EXTERN tree m2type_gm2_type_for_size (unsigned int bits, int unsignedp); EXTERN tree m2type_BuildProcTypeParameterDeclaration (location_t location, tree type, bool isreference); -EXTERN int m2type_IsAddress (tree type); +EXTERN bool m2type_IsAddress (tree type); EXTERN tree m2type_GetCardinalAddressType (void); EXTERN bool m2type_SameRealType (tree a, tree b); - +EXTERN bool m2type_IsGccStrictTypeEquivalent (tree left, tree right); #undef EXTERN #endif /* m2type_h */ diff --git a/gcc/m2/lang.opt.urls b/gcc/m2/lang.opt.urls index 4c3e690..dc1dbf0 100644 --- a/gcc/m2/lang.opt.urls +++ b/gcc/m2/lang.opt.urls @@ -72,8 +72,8 @@ UrlSuffix(gcc/Preprocessor-Options.html#index-P) LangUrlSuffix_Fortran(gfortran/ ; skipping UrlSuffix for 'ansi' due to multiple URLs: ; duplicate: 'gcc/C-Dialect-Options.html#index-ansi-1' +; duplicate: 'gcc/Library-Builtins.html#index-ansi-2' ; duplicate: 'gcc/Non-bugs.html#index-ansi-3' -; duplicate: 'gcc/Other-Builtins.html#index-ansi-2' ; duplicate: 'gcc/Standards.html#index-ansi' ; skipping UrlSuffix for 'c' due to multiple URLs: |