diff options
177 files changed, 6103 insertions, 1698 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 8091f67..073dd35 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,92 @@ +2025-11-05 Nathaniel Shead <nathanieloshead@gmail.com> + + PR c++/121574 + * doc/invoke.texi: Document '-Wexpose-global-module-tu-local'. + +2025-11-05 Artemiy Volkov <artemiy.volkov@arm.com> + + * tree-ssa-forwprop.cc (simplify_vector_constructor): Support + vector constructor elements. + * tree-vect-generic.cc (ssa_uniform_vector_p): Make non-static and + move ... + * tree.cc (ssa_uniform_vector_p): ... here. + * tree.h (ssa_uniform_vector_p): Declare it. + +2025-11-05 Richard Biener <rguenther@suse.de> + + * tree-ssa-forwprop.cc (forward_propagate_addr_expr): + Use gather_imm_use_stmts instead of FOR_EACH_IMM_USE_STMT. + +2025-11-05 Richard Biener <rguenther@suse.de> + + * gimple.h (gimple::pad): Rename to ... + (gimple::ilf): ... this. + * ssa-iterators.h (gather_imm_use_stmts): Declare. + * tree-ssa-operands.cc (gather_imm_use_stmts): New function. + +2025-11-05 Richard Biener <rguenther@suse.de> + + * gimple-ssa-isolate-paths.cc (check_loadstore): Set + the volatile flag on the stmt manually. + (find_implicit_erroneous_behavior): Move code transform + outside of FOR_EACH_IMM_USE_STMT iteration. + +2025-11-05 Richard Biener <rguenther@suse.de> + + * tree-ssa-loop-niter.cc (dump_affine_iv): Use file, not + dump_file when printing. + (debug): New overload for affine_iv. + +2025-11-05 Xi Ruoyao <xry111@xry111.site> + + * config/loongarch/loongarch.md (cntmap): Change to uppercase. + (popcount<GPR:mode>2): Modify to a post reload split. + +2025-11-04 Uros Bizjak <ubizjak@gmail.com> + + PR target/122390 + * config/i386/i386.md (*add<mode>3_carry_2): New insn pattern. + (*add<mode>3_carry_0_cc): Ditto. + (*add<mode>3_carry_0r_cc): Ditto. + (*sub<mode>3_carry_2): Ditto. + (*sub<mode>3_carry_0_cc): Ditto. + (*sub<mode>3_carry_0r_cc): Ditt. + +2025-11-04 Kees Cook <kees@kernel.org> + + * config/arc/builtins.def: Add ATTRS parameter to DEF_BUILTIN + macro calls. Mark mathematical builtins (FFS, FLS, NORM, NORMW, + SWAP) with attr_const, leave others as NULL_TREE. + * config/arc/arc.cc: Add support for builtin function attributes. + Create attr_const using tree_cons. Update DEF_BUILTIN macro to + pass ATTRS parameter to add_builtin_function. + +2025-11-04 Pan Li <pan2.li@intel.com> + + * match.pd: Add usmul_widen_mult helper and referenced by + min based unsigned SAT_MUL pattern. + +2025-11-04 Siddhesh Poyarekar <siddhesh@gotplt.org> + + PR lto/122515 + * lto-wrapper.cc (debug_objcopy): Set type of INOFF to int64_t. + (run_gcc): Set type of FILE_OFFSET to int64_t. + +2025-11-04 Kishan Parmar <kishan@linux.ibm.com> + + PR rtl-optimization/93738 + * simplify-rtx.cc (simplify_binary_operation_1): Canonicalize + SUBREG(LSHIFTRT) into LSHIFTRT(SUBREG) when valid. + +2025-11-04 David Malcolm <dmalcolm@redhat.com> + + PR analyzer/122544 + * diagnostics/paths.cc (event::meaning::maybe_get_verb_str): + Handle the new verbs. + * diagnostics/paths.h (event::meaning::verb): Add new values + for special control flow operations. + (event::meaning::meaning): Add ctor taking just a verb. + 2025-11-03 Uros Bizjak <ubizjak@gmail.com> PR target/122534 diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 23733dc..02b442e 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20251104 +20251106 diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c99021a..51f57e3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2025-11-05 Eric Botcazou <ebotcazou@adacore.com> + + PR ada/35793 + * sem_res.adb (Check_Discriminant_Use): In a constraint context, + check that the discriminant appears alone as a direct name in all + cases and give a consistent error message when it does not. + +2025-11-04 Eric Botcazou <ebotcazou@adacore.com> + + * sem_ch3.adb (Analyze_Subtype_Declaration) <Concurrent_Kind>: + Propagate the Uses_Lock_Free flag for protected types. + +2025-11-04 Eric Botcazou <ebotcazou@adacore.com> + + PR ada/18453 + * sem_ch12.adb (Find_Actual_Type): Add Typ_Ref parameter and + perform a standard resolution on it in the fallback case. + Call Get_Instance_Of if the type is declared in a formal of + the child unit. + (Instantiate_Type.Validate_Access_Type_Instance): Adjust call + to Find_Actual_Type. + (Instantiate_Type.Validate_Array_Type_Instance): Likewise and + streamline the check for matching component subtypes. + 2025-11-03 Eric Botcazou <ebotcazou@adacore.com> PR ada/78175 diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb index d2f3df8..4e4a6ec 100644 --- a/gcc/ada/exp_ch2.adb +++ b/gcc/ada/exp_ch2.adb @@ -117,8 +117,7 @@ package body Exp_Ch2 is procedure Expand_Renaming (N : Node_Id); -- For renamings, just replace the identifier by the corresponding -- named expression. Note that this has been evaluated (see routine - -- Exp_Ch8.Expand_N_Object_Renaming.Evaluate_Name) so this gives - -- the correct renaming semantics. + -- Exp_Util.Evaluate_Name) so this gives correct renaming semantics. -------------------------- -- Expand_Current_Value -- diff --git a/gcc/ada/exp_ch8.adb b/gcc/ada/exp_ch8.adb index 2ddf75f..3f9dbe8 100644 --- a/gcc/ada/exp_ch8.adb +++ b/gcc/ada/exp_ch8.adb @@ -344,22 +344,9 @@ package body Exp_Ch8 is -- Start of processing for Expand_N_Subprogram_Renaming_Declaration begin - -- When the prefix of the name is a function call, we must force the - -- call to be made by removing side effects from the call, since we - -- must only call the function once. + -- Perform name evaluation in all cases - if Nkind (Nam) = N_Selected_Component - and then Nkind (Prefix (Nam)) = N_Function_Call - then - Remove_Side_Effects (Prefix (Nam)); - - -- For an explicit dereference, the prefix must be captured to prevent - -- reevaluation on calls through the renaming, which could result in - -- calling the wrong subprogram if the access value were to be changed. - - elsif Nkind (Nam) = N_Explicit_Dereference then - Force_Evaluation (Prefix (Nam)); - end if; + Evaluate_Name (Nam); -- Handle cases where we build a body for a renamed equality diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 363abe3..b6f5ed0 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -642,8 +642,9 @@ package body Sem_Ch12 is -- of freeze nodes for instance bodies that may depend on other instances. function Find_Actual_Type - (Typ : Entity_Id; - Gen_Type : Entity_Id) return Entity_Id; + (Typ : Entity_Id; + Gen_Type : Entity_Id; + Typ_Ref : Node_Id) return Entity_Id; -- When validating the actual types of a child instance, check whether -- the formal is a formal type of the parent unit, and retrieve the current -- actual for it. Typ is the entity in the analyzed formal type declaration @@ -653,7 +654,8 @@ package body Sem_Ch12 is -- be declared in a formal package of a parent. In both cases it is a -- generic actual type because it appears within a visible instance. -- Finally, it may be declared in a parent unit without being a formal - -- of that unit, in which case it must be retrieved by visibility. + -- of that unit, in which case it must be retrieved by visibility and + -- Typ_Ref is the unanalyzed subtype mark in the instance to be used. -- Ambiguities may still arise if two homonyms are declared in two formal -- packages, and the prefix of the formal type may be needed to resolve -- the ambiguity in the instance ??? @@ -10465,10 +10467,10 @@ package body Sem_Ch12 is function Find_Actual_Type (Typ : Entity_Id; - Gen_Type : Entity_Id) return Entity_Id + Gen_Type : Entity_Id; + Typ_Ref : Node_Id) return Entity_Id is Gen_Scope : constant Entity_Id := Scope (Gen_Type); - T : Entity_Id; begin -- Special processing only applies to child units @@ -10482,6 +10484,12 @@ package body Sem_Ch12 is elsif Scope (Typ) = Gen_Scope then return Get_Instance_Of (Typ); + -- If designated or component type is declared in a formal of the child + -- unit, its instance is available. + + elsif Scope (Scope (Typ)) = Gen_Scope then + return Get_Instance_Of (Typ); + -- If the array or access type is not declared in the parent unit, -- no special processing needed. @@ -10493,18 +10501,8 @@ package body Sem_Ch12 is -- Otherwise, retrieve designated or component type by visibility else - T := Current_Entity (Typ); - while Present (T) loop - if In_Open_Scopes (Scope (T)) then - return T; - elsif Is_Generic_Actual_Type (T) then - return T; - end if; - - T := Homonym (T); - end loop; - - return Typ; + Analyze (Typ_Ref); + return Entity (Typ_Ref); end if; end Find_Actual_Type; @@ -14596,7 +14594,8 @@ package body Sem_Ch12 is procedure Validate_Access_Type_Instance is Desig_Type : constant Entity_Id := - Find_Actual_Type (Designated_Type (A_Gen_T), A_Gen_T); + Find_Actual_Type + (Designated_Type (A_Gen_T), A_Gen_T, Subtype_Indication (Def)); Desig_Act : Entity_Id; begin @@ -14685,31 +14684,15 @@ package body Sem_Ch12 is ---------------------------------- procedure Validate_Array_Type_Instance is - I1 : Node_Id; - I2 : Node_Id; - T2 : Entity_Id; - - function Formal_Dimensions return Nat; - -- Count number of dimensions in array type formal + Dims : constant List_Id + := (if Nkind (Def) = N_Constrained_Array_Definition + then Discrete_Subtype_Definitions (Def) + else Subtype_Marks (Def)); - ----------------------- - -- Formal_Dimensions -- - ----------------------- - - function Formal_Dimensions return Nat is - Dims : List_Id; - - begin - if Nkind (Def) = N_Constrained_Array_Definition then - Dims := Discrete_Subtype_Definitions (Def); - else - Dims := Subtype_Marks (Def); - end if; - - return List_Length (Dims); - end Formal_Dimensions; - - -- Start of processing for Validate_Array_Type_Instance + Dim : Node_Id; + I1 : Node_Id; + I2 : Node_Id; + T2 : Entity_Id; begin if not Is_Array_Type (Act_T) then @@ -14734,15 +14717,16 @@ package body Sem_Ch12 is end if; end if; - if Formal_Dimensions /= Number_Dimensions (Act_T) then + if List_Length (Dims) /= Number_Dimensions (Act_T) then Error_Msg_NE ("dimensions of actual do not match formal &", Actual, Gen_T); Abandon_Instantiation (Actual); end if; - I1 := First_Index (A_Gen_T); - I2 := First_Index (Act_T); - for J in 1 .. Formal_Dimensions loop + Dim := First (Dims); + I1 := First_Index (A_Gen_T); + I2 := First_Index (Act_T); + for J in 1 .. List_Length (Dims) loop -- If the indexes of the actual were given by a subtype_mark, -- the index was transformed into a range attribute. Retrieve @@ -14765,7 +14749,13 @@ package body Sem_Ch12 is end if; if not Subtypes_Match - (Find_Actual_Type (Etype (I1), A_Gen_T), T2) + (Find_Actual_Type + (Etype (I1), + A_Gen_T, + (if Nkind (Dim) = N_Subtype_Indication + then Subtype_Mark (Dim) + else Dim)), + T2) then Error_Msg_NE ("index types of actual do not match those of formal &", @@ -14773,34 +14763,20 @@ package body Sem_Ch12 is Abandon_Instantiation (Actual); end if; + Next (Dim); Next_Index (I1); Next_Index (I2); end loop; - -- Check matching subtypes. Note that there are complex visibility - -- issues when the generic is a child unit and some aspect of the - -- generic type is declared in a parent unit of the generic. We do - -- the test to handle this special case only after a direct check - -- for static matching has failed. The case where both the component - -- type and the array type are separate formals, and the component - -- type is a private view may also require special checking in - -- Subtypes_Match. Finally, we assume that a child instance where - -- the component type comes from a formal of a parent instance is - -- correct because the generic was correct. A more precise check - -- seems too complex to install??? - - if Subtypes_Match - (Component_Type (A_Gen_T), Component_Type (Act_T)) - or else - Subtypes_Match - (Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T), - Component_Type (Act_T)) - or else - (not Inside_A_Generic - and then Is_Child_Unit (Scope (Component_Type (A_Gen_T)))) + -- Check matching component subtypes + + if not Subtypes_Match + (Find_Actual_Type + (Component_Type (A_Gen_T), + A_Gen_T, + Subtype_Indication (Component_Definition (Def))), + Component_Type (Act_T)) then - null; - else Error_Msg_NE ("component subtype of actual does not match that of formal &", Actual, Gen_T); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 233f823..ba0af27 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -6145,6 +6145,10 @@ package body Sem_Ch3 is Set_Is_Tagged_Type (Id, Is_Tagged_Type (T)); Set_Last_Entity (Id, Last_Entity (T)); + if Is_Protected_Type (T) then + Set_Uses_Lock_Free (Id, Uses_Lock_Free (T)); + end if; + if Is_Tagged_Type (T) then Set_No_Tagged_Streams_Pragma (Id, No_Tagged_Streams_Pragma (T)); diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 5704bf1..54df44d 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -7147,7 +7147,7 @@ package body Sem_Ch4 is and then N = Prefix (Parent (N)) then Error_Msg_N -- CODEFIX - ("\period should probably be semicolon", Parent (N)); + ("\period is probably a typographical error", Parent (N)); end if; end if; diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index fe7f311..11f2b19 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -1873,13 +1873,13 @@ package body Sem_Ch8 is New_S : Entity_Id; Is_Body : Boolean) is - Nam : constant Node_Id := Name (N); - Sel : constant Node_Id := Selector_Name (Nam); - Is_Actual : constant Boolean := Present (Corresponding_Formal_Spec (N)); - Old_S : Entity_Id; + Nam : constant Node_Id := Name (N); + P : constant Node_Id := Prefix (Nam); + + Old_S : Entity_Id; begin - if Entity (Sel) = Any_Id then + if Entity (Selector_Name (Nam)) = Any_Id then -- Selector is undefined on prefix. Error emitted already @@ -1910,10 +1910,11 @@ package body Sem_Ch8 is -- The prefix can be an arbitrary expression that yields a task or -- protected object, so it must be resolved. - if Is_Access_Type (Etype (Prefix (Nam))) then - Insert_Explicit_Dereference (Prefix (Nam)); + if Is_Access_Type (Etype (P)) then + Insert_Explicit_Dereference (P); end if; - Resolve (Prefix (Nam), Scope (Old_S)); + + Resolve (P, Scope (Old_S)); end if; Set_Convention (New_S, Convention (Old_S)); @@ -1924,9 +1925,9 @@ package body Sem_Ch8 is if Is_Protected_Type (Scope (Old_S)) and then Ekind (New_S) = E_Procedure - and then not Is_Variable (Prefix (Nam)) + and then not Is_Variable (P) then - if Is_Actual then + if Present (Corresponding_Formal_Spec (N)) then Error_Msg_N ("target object of protected operation used as actual for " & "formal procedure must be a variable", Nam); @@ -1951,8 +1952,9 @@ package body Sem_Ch8 is New_S : Entity_Id; Is_Body : Boolean) is - Nam : constant Node_Id := Name (N); - P : constant Node_Id := Prefix (Nam); + Nam : constant Node_Id := Name (N); + P : constant Node_Id := Prefix (Nam); + Old_S : Entity_Id; begin @@ -1995,13 +1997,13 @@ package body Sem_Ch8 is New_S : Entity_Id; Is_Body : Boolean) is - Old_S : Entity_Id; - Nam : Entity_Id; + Nam : constant Node_Id := Name (N); + P : constant Node_Id := Prefix (Nam); function Conforms (Subp : Entity_Id; Ctyp : Conformance_Type) return Boolean; - -- Verify that the signatures of the renamed entity and the new entity + -- Verify that the profiles of the renamed entity and the new entity -- match. The first formal of the renamed entity is skipped because it -- is the target object in any subsequent call. @@ -2038,14 +2040,16 @@ package body Sem_Ch8 is Next_Formal (Old_F); end loop; - return True; + return No (Old_F) and then No (New_F); end Conforms; + Old_S : Entity_Id; + -- Start of processing for Analyze_Renamed_Primitive_Operation begin - if not Is_Overloaded (Selector_Name (Name (N))) then - Old_S := Entity (Selector_Name (Name (N))); + if not Is_Overloaded (Selector_Name (Nam)) then + Old_S := Entity (Selector_Name (Nam)); if not Conforms (Old_S, Type_Conformant) then Old_S := Any_Id; @@ -2060,7 +2064,7 @@ package body Sem_Ch8 is begin Old_S := Any_Id; - Get_First_Interp (Selector_Name (Name (N)), Ind, It); + Get_First_Interp (Selector_Name (Nam), Ind, It); while Present (It.Nam) loop if Conforms (It.Nam, Type_Conformant) then @@ -2094,20 +2098,18 @@ package body Sem_Ch8 is -- AI12-0204: The prefix of a prefixed view that is renamed or -- passed as a formal subprogram must be renamable as an object. - Nam := Prefix (Name (N)); - - if Is_Object_Reference (Nam) then - if Is_Dependent_Component_Of_Mutable_Object (Nam) then + if Is_Object_Reference (P) then + if Is_Dependent_Component_Of_Mutable_Object (P) then Error_Msg_N ("illegal renaming of discriminant-dependent component", - Nam); - elsif Depends_On_Mutably_Tagged_Ext_Comp (Nam) then + P); + elsif Depends_On_Mutably_Tagged_Ext_Comp (P) then Error_Msg_N ("illegal renaming of mutably tagged dependent component", - Nam); + P); end if; else - Error_Msg_N ("expect object name in renaming", Nam); + Error_Msg_N ("expect object name in renaming", P); end if; -- Enforce the rule given in (RM 6.3.1 (10.1/2)): a prefixed @@ -2119,12 +2121,16 @@ package body Sem_Ch8 is Set_Convention (New_S, Convention_Intrinsic); end if; - -- Inherit_Renamed_Profile (New_S, Old_S); + Set_Entity (Selector_Name (Nam), Old_S); -- The prefix can be an arbitrary expression that yields an -- object, so it must be resolved. - Resolve (Prefix (Name (N))); + if Is_Access_Type (Etype (P)) then + Insert_Explicit_Dereference (P); + end if; + + Resolve (P); end if; end Analyze_Renamed_Primitive_Operation; @@ -8504,92 +8510,104 @@ package body Sem_Ch8 is end; end if; + -- Case of the enclosing construct + if In_Open_Scopes (P_Name) then Set_Entity (P, P_Name); Set_Is_Overloaded (P, False); Find_Expanded_Name (N); + -- If no interpretation as an expanded name is possible, then it + -- must be a selected component of a record returned by a function + -- call. Reformat the prefix as a function call and analyze it. + else - -- If no interpretation as an expanded name is possible, it - -- must be a selected component of a record returned by a - -- function call. Reformat prefix as a function call, the rest - -- is done by type resolution. + declare + procedure Diagnose_Call; + -- Try and give useful diagnostics on error - -- Error if the prefix is procedure or entry, as is P.X + ------------------- + -- Diagnose_Call -- + ------------------- - if Ekind (P_Name) /= E_Function - and then - (not Is_Overloaded (P) - or else Nkind (Parent (N)) = N_Procedure_Call_Statement) - then - -- Prefix may mention a package that is hidden by a local - -- declaration: let the user know. Scan the full homonym - -- chain, the candidate package may be anywhere on it. + procedure Diagnose_Call is + Ent : Entity_Id; - if Present (Homonym (Current_Entity (P_Name))) then - P_Name := Current_Entity (P_Name); + begin + -- Prefix may mention a package that is hidden by a local + -- declaration: let the user know. Scan the full homonym + -- chain, the candidate package may be anywhere on it. - while Present (P_Name) loop - exit when Ekind (P_Name) = E_Package; - P_Name := Homonym (P_Name); + Ent := Current_Entity (P_Name); + + while Present (Ent) loop + exit when Ekind (Ent) = E_Package; + Ent := Homonym (Ent); end loop; - if Present (P_Name) then - if not Is_Reference_In_Subunit then - Error_Msg_Sloc := Sloc (Entity (Prefix (N))); - Error_Msg_NE - ("package& is hidden by declaration#", N, P_Name); - end if; + if Present (Ent) and then not Is_Reference_In_Subunit then + Error_Msg_Sloc := Sloc (P_Name); + Error_Msg_NE + ("\package& is hidden by declaration#", N, Ent); + end if; - Set_Entity (Prefix (N), P_Name); - Find_Expanded_Name (N); - return; + -- Format node as expanded name, to avoid cascaded errors - else - P_Name := Entity (Prefix (N)); - end if; - end if; + Change_Selected_Component_To_Expanded_Name (N); + Set_Entity (N, Any_Id); + Set_Etype (N, Any_Type); + end Diagnose_Call; - Error_Msg_NE - ("invalid prefix in selected component&", N, P_Name); - Change_Selected_Component_To_Expanded_Name (N); - Set_Entity (N, Any_Id); - Set_Etype (N, Any_Type); + begin + -- Error if the prefix is procedure or entry, as in P.X - -- Here we have a function call, so do the reformatting + if Ekind (P_Name) /= E_Function + and then not Is_Overloaded (P) + then + Error_Msg_NE + ("invalid prefix& in selected component", N, P_Name); + Diagnose_Call; + return; - else - Nam := New_Copy (P); - Save_Interps (P, Nam); + -- Here we may have a function call, so do the reformatting + + else + Nam := New_Copy (P); + Save_Interps (P, Nam); - -- We use Replace here because this is one of those cases - -- where the parser has missclassified the node, and we fix - -- things up and then do the semantic analysis on the fixed - -- up node. Normally we do this using one of the Sinfo.CN - -- routines, but this is too tricky for that. + -- We use Replace here because this is one of those cases + -- where the parser has misclassified the node and we fix + -- things up and then do semantic analysis on the fixed + -- up node. Normally we do this using one of the Sinfo.CN + -- routines, but this is too tricky for that. - -- Note that using Rewrite would be wrong, because we would - -- have a tree where the original node is unanalyzed. + -- Note that using Rewrite would be wrong, since we would + -- have a tree where the original node is unanalyzed. - Replace (P, - Make_Function_Call (Sloc (P), Name => Nam)); + Replace (P, Make_Function_Call (Sloc (P), Name => Nam)); - -- Now analyze the reformatted node + -- Now analyze the reformatted node - Analyze_Call (P); + Analyze_Call (P); - -- If the prefix is illegal after this transformation, there - -- may be visibility errors on the prefix. The safest is to - -- treat the selected component as an error. + -- If the prefix is illegal after this transformation, + -- there may be a visibility error on the prefix. The + -- safest is to treat the selected component as an error. - if Error_Posted (P) then - Set_Etype (N, Any_Type); - return; + if Error_Posted (P) then + Diagnose_Call; + return; - else - Analyze_Selected_Component (N); + else + Analyze_Selected_Component (N); + + if Error_Posted (N) then + Diagnose_Call; + return; + end if; + end if; end if; - end if; + end; end if; -- Remaining cases generate various error messages diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index bf9d5e1..301894b 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -658,6 +658,24 @@ package body Sem_Res is P : Node_Id; D : Node_Id; + procedure Check_Legality_In_Constraint (Alone : Boolean); + -- RM 3.8(12/3): Check that the discriminant mentioned in a constraint + -- appears alone as a direct name. + + ---------------------------------- + -- Check_Legality_In_Constraint -- + ---------------------------------- + + procedure Check_Legality_In_Constraint (Alone : Boolean) is + begin + if not Alone then + Error_Msg_N ("discriminant in constraint must appear alone", N); + + elsif Nkind (N) = N_Expanded_Name and then Comes_From_Source (N) then + Error_Msg_N ("discriminant must appear alone as a direct name", N); + end if; + end Check_Legality_In_Constraint; + begin -- Any use in a spec-expression is legal @@ -694,19 +712,11 @@ package body Sem_Res is -- processing for records). See Sem_Ch3.Build_Derived_Record_Type -- for more info. - if Ekind (Current_Scope) = E_Record_Type - and then Scope (Disc) = Current_Scope - and then not - (Nkind (Parent (P)) = N_Subtype_Indication - and then - Nkind (Parent (Parent (P))) in N_Component_Definition - | N_Subtype_Declaration - and then Paren_Count (N) = 0) - then - Error_Msg_N - ("discriminant must appear alone in component constraint", N); - return; - end if; + Check_Legality_In_Constraint + (Nkind (Parent (P)) = N_Subtype_Indication + and then Nkind (Parent (Parent (P))) in N_Component_Definition + | N_Subtype_Declaration + and then Paren_Count (N) = 0); -- Detect a common error: @@ -817,18 +827,7 @@ package body Sem_Res is elsif Nkind (PN) in N_Index_Or_Discriminant_Constraint | N_Discriminant_Association then - if Paren_Count (N) > 0 then - Error_Msg_N - ("discriminant in constraint must appear alone", N); - - elsif Nkind (N) = N_Expanded_Name - and then Comes_From_Source (N) - then - Error_Msg_N - ("discriminant must appear alone as a direct name", N); - end if; - - return; + Check_Legality_In_Constraint (Paren_Count (N) = 0); -- Otherwise, context is an expression. It should not be within (i.e. a -- subexpression of) a constraint for a component. @@ -863,8 +862,7 @@ package body Sem_Res is or else Nkind (P) = N_Entry_Declaration or else Nkind (D) = N_Defining_Identifier then - Error_Msg_N - ("discriminant in constraint must appear alone", N); + Check_Legality_In_Constraint (False); end if; end if; end Check_Discriminant_Use; diff --git a/gcc/analyzer/ChangeLog b/gcc/analyzer/ChangeLog index 3de38b2..f774184 100644 --- a/gcc/analyzer/ChangeLog +++ b/gcc/analyzer/ChangeLog @@ -1,3 +1,17 @@ +2025-11-04 David Malcolm <dmalcolm@redhat.com> + + PR analyzer/122544 + * checker-event.cc (catch_cfg_edge_event::get_meaning): New. + (setjmp_event::get_meaning): New. + (rewind_event::get_meaning): New. + (throw_event::get_meaning): New. + (unwind_event::get_meaning): New. + * checker-event.h (catch_cfg_edge_event::get_meaning): New decl. + (setjmp_event::get_meaning): New decl. + (rewind_event::get_meaning): New decl. + (throw_event::get_meaning): New decl. + (unwind_event::get_meaning): New decl. + 2025-10-16 David Malcolm <dmalcolm@redhat.com> * ana-state-to-diagnostic-state.cc: Reimplement throughout to use diff --git a/gcc/analyzer/checker-event.cc b/gcc/analyzer/checker-event.cc index 790ebc7..3e54c2a 100644 --- a/gcc/analyzer/checker-event.cc +++ b/gcc/analyzer/checker-event.cc @@ -833,6 +833,14 @@ start_cfg_edge_event::should_print_expr_p (tree expr) return false; } +/* class catch_cfg_edge_event : public cfg_edge_event. */ + +diagnostics::paths::event::meaning +catch_cfg_edge_event::get_meaning () const +{ + return meaning (verb::catch_); +} + /* class call_event : public superedge_event. */ /* call_event's ctor. */ @@ -1034,6 +1042,12 @@ setjmp_event::print_desc (pretty_printer &pp) const get_user_facing_name (m_setjmp_call)); } +diagnostics::paths::event::meaning +setjmp_event::get_meaning () const +{ + return meaning (verb::setjmp_); +} + /* Implementation of checker_event::prepare_for_emission vfunc for setjmp_event. Record this setjmp's event ID into the path, so that rewind events can @@ -1066,6 +1080,12 @@ rewind_event::get_setjmp_caller () const return m_eedge->m_dest->get_function ()->decl; } +diagnostics::paths::event::meaning +rewind_event::get_meaning () const +{ + return meaning (verb::longjmp_); +} + /* rewind_event's ctor. */ rewind_event::rewind_event (const exploded_edge *eedge, @@ -1163,6 +1183,12 @@ rewind_to_setjmp_event::prepare_for_emission (checker_path *path, /* class throw_event : public checker_event. */ +diagnostics::paths::event::meaning +throw_event::get_meaning () const +{ + return meaning (verb::throw_); +} + /* class explicit_throw_event : public throw_event. */ void explicit_throw_event::print_desc (pretty_printer &pp) const @@ -1205,6 +1231,12 @@ unwind_event::print_desc (pretty_printer &pp) const pp_printf (&pp, "unwinding stack frame"); } +diagnostics::paths::event::meaning +unwind_event::get_meaning () const +{ + return meaning (verb::unwind_); +} + /* class warning_event : public checker_event. */ /* Implementation of diagnostics::paths::event::print_desc vfunc for diff --git a/gcc/analyzer/checker-event.h b/gcc/analyzer/checker-event.h index 909e388..fc51be1 100644 --- a/gcc/analyzer/checker-event.h +++ b/gcc/analyzer/checker-event.h @@ -539,6 +539,8 @@ public: pp_string (&pp, "...catching exception here"); } + meaning get_meaning () const override; + private: tree m_type; }; @@ -666,6 +668,8 @@ public: void print_desc (pretty_printer &pp) const final override; + meaning get_meaning () const override; + void prepare_for_emission (checker_path *path, pending_diagnostic *pd, diagnostics::paths::event_id_t emission_id) final override; @@ -688,6 +692,8 @@ public: tree get_setjmp_caller () const; const exploded_edge *get_eedge () const { return m_eedge; } + meaning get_meaning () const override; + protected: rewind_event (const exploded_edge *eedge, enum event_kind kind, @@ -754,6 +760,8 @@ public: { } + meaning get_meaning () const override; + protected: const exploded_node *m_enode; const gcall &m_throw_call; @@ -817,6 +825,8 @@ public: { } + meaning get_meaning () const override; + void print_desc (pretty_printer &pp) const final override; int m_num_frames; diff --git a/gcc/c-family/ChangeLog b/gcc/c-family/ChangeLog index d4982eb..423a1aa 100644 --- a/gcc/c-family/ChangeLog +++ b/gcc/c-family/ChangeLog @@ -1,3 +1,20 @@ +2025-11-05 Nathaniel Shead <nathanieloshead@gmail.com> + + PR c++/121574 + * c.opt: New warning '-Wexpose-global-module-tu-local'. + * c.opt.urls: Regenerate. + +2025-11-04 Alejandro Colomar <alx@kernel.org> + + * c-warn.cc (warn_parms_array_mismatch): Fix typos in comment. + +2025-11-04 Alejandro Colomar <alx@kernel.org> + + * c-common.h (warn_parm_array_mismatch): + Rename warn_parm_array_mismatch => warn_parms_array_mismatch. + * c-warn.cc (warn_parm_array_mismatch): + Rename warn_parm_array_mismatch => warn_parms_array_mismatch. + 2025-10-30 Qing Zhao <qing.zhao@oracle.com> * c-attribs.cc (handle_counted_by_attribute): Allow counted_by for diff --git a/gcc/c-family/c-common.h b/gcc/c-family/c-common.h index bedbd4a..8b7f4ae4 100644 --- a/gcc/c-family/c-common.h +++ b/gcc/c-family/c-common.h @@ -1624,7 +1624,7 @@ extern void c_do_switch_warnings (splay_tree, location_t, tree, tree, bool); extern void warn_for_omitted_condop (location_t, tree); extern bool warn_for_restrict (unsigned, tree *, unsigned); extern void warn_for_address_of_packed_member (tree, tree); -extern void warn_parm_array_mismatch (location_t, tree, tree); +extern void warn_parms_array_mismatch (location_t, tree, tree); extern void maybe_warn_sizeof_array_div (location_t, tree, tree, tree, tree); extern void do_warn_array_compare (location_t, tree_code, tree, tree); diff --git a/gcc/c-family/c-warn.cc b/gcc/c-family/c-warn.cc index 09517d2..cc127de 100644 --- a/gcc/c-family/c-warn.cc +++ b/gcc/c-family/c-warn.cc @@ -3431,7 +3431,7 @@ expr_to_str (pretty_printer &pp, tree expr, const char *dflt) (FNDECL's is set to the location of the redeclaration). */ void -warn_parm_array_mismatch (location_t origloc, tree fndecl, tree newparms) +warn_parms_array_mismatch (location_t origloc, tree fndecl, tree newparms) { /* The original parameter list (copied from the original declaration into the current [re]declaration, FNDECL)). The two are equal if @@ -3505,8 +3505,8 @@ warn_parm_array_mismatch (location_t origloc, tree fndecl, tree newparms) if (!newa) { - /* Continue of both parameters are pointers with no size - associated with it. */ + /* Continue if both parameters are pointers with no size + associated with them. */ if (!cura) continue; diff --git a/gcc/c-family/c.opt b/gcc/c-family/c.opt index b7ce67a..85dc3d8 100644 --- a/gcc/c-family/c.opt +++ b/gcc/c-family/c.opt @@ -765,6 +765,10 @@ Wexternal-tu-local C++ ObjC++ Var(warn_tu_local) Warning Init(1) Warn about naming a TU-local entity declared in another translation unit. +Wexpose-global-module-tu-local +C++ ObjC++ Var(warn_expose_global_module_tu_local) Init(1) Warning +Warn when a module exposes a TU-local entity from the global module fragment. + Wextra C ObjC C++ ObjC++ Warning ; in common.opt diff --git a/gcc/c-family/c.opt.urls b/gcc/c-family/c.opt.urls index 399f9f8..55dbbcd 100644 --- a/gcc/c-family/c.opt.urls +++ b/gcc/c-family/c.opt.urls @@ -379,6 +379,9 @@ UrlSuffix(gcc/Warning-Options.html#index-Wexpansion-to-defined) Wexternal-tu-local UrlSuffix(gcc/C_002b_002b-Dialect-Options.html#index-Wexternal-tu-local) +Wexpose-global-module-tu-local +UrlSuffix(gcc/C_002b_002b-Dialect-Options.html#index-Wexpose-global-module-tu-local) + Wextra UrlSuffix(gcc/Warning-Options.html#index-Wextra) LangUrlSuffix_D(gdc/Warnings.html#index-Wextra) LangUrlSuffix_Fortran(gfortran/Error-and-Warning-Options.html#index-Wextra) diff --git a/gcc/c/ChangeLog b/gcc/c/ChangeLog index 23cc53a..7894b76 100644 --- a/gcc/c/ChangeLog +++ b/gcc/c/ChangeLog @@ -1,3 +1,10 @@ +2025-11-04 Alejandro Colomar <alx@kernel.org> + + * c-decl.cc (start_function): + Rename warn_parm_array_mismatch => warn_parms_array_mismatch. + * c-parser.cc (c_parser_declaration_or_fndef): + Rename warn_parm_array_mismatch => warn_parms_array_mismatch. + 2025-11-01 Martin Uecker <uecker@tugraz.at> * c-decl.cc (build_compound_literal): Add error. diff --git a/gcc/c/c-decl.cc b/gcc/c/c-decl.cc index 1e1da2d..0a368e4 100644 --- a/gcc/c/c-decl.cc +++ b/gcc/c/c-decl.cc @@ -10920,7 +10920,7 @@ start_function (struct c_declspecs *declspecs, struct c_declarator *declarator, if (old_decl) { location_t origloc = DECL_SOURCE_LOCATION (old_decl); - warn_parm_array_mismatch (origloc, old_decl, parms); + warn_parms_array_mismatch (origloc, old_decl, parms); } /* To enable versions to be created across TU's we mark and mangle all diff --git a/gcc/c/c-parser.cc b/gcc/c/c-parser.cc index 9b3a786..d8b7bee 100644 --- a/gcc/c/c-parser.cc +++ b/gcc/c/c-parser.cc @@ -3013,7 +3013,7 @@ c_parser_declaration_or_fndef (c_parser *parser, bool fndef_ok, && DECL_INITIAL (d) == NULL_TREE) DECL_ARGUMENTS (d) = parms; - warn_parm_array_mismatch (lastloc, d, parms); + warn_parms_array_mismatch (lastloc, d, parms); } } if (omp_declare_simd_clauses diff --git a/gcc/cobol/Make-lang.in b/gcc/cobol/Make-lang.in index ed6b588..9f28752 100644 --- a/gcc/cobol/Make-lang.in +++ b/gcc/cobol/Make-lang.in @@ -330,7 +330,7 @@ cobol.srcpdf: gcobol.pdf gcobol-io.pdf ln $^ $(srcdir)/cobol/ gcobol.pdf: $(srcdir)/cobol/gcobol.1 - groff -mdoc -T pdf $^ > $@~ + groff -mdoc -t -T pdf $^ > $@~ @mv $@~ $@ gcobol-io.pdf: $(srcdir)/cobol/gcobol.3 groff -mdoc -T pdf $^ > $@~ diff --git a/gcc/cobol/cdf.y b/gcc/cobol/cdf.y index f72ed77..2d3f819 100644 --- a/gcc/cobol/cdf.y +++ b/gcc/cobol/cdf.y @@ -244,21 +244,21 @@ apply_cdf_turn( const exception_turn_t& turn ) { %type <boolean> DEFINED %token OTHER 699 PARAMETER_kw 369 "PARAMETER" %token OFF 688 OVERRIDE 370 -%token THRU 949 -%token TRUE_kw 814 "True" +%token THRU 950 +%token TRUE_kw 815 "True" %token CALL_COBOL 393 "CALL" %token CALL_VERBATIM 394 "CALL (as C)" -%token TURN 816 CHECKING 497 LOCATION 650 ON 690 WITH 843 +%token TURN 817 CHECKING 497 LOCATION 650 ON 690 WITH 844 -%left OR 950 -%left AND 951 -%right NOT 952 -%left '<' '>' '=' NE 953 LE 954 GE 955 +%left OR 951 +%left AND 952 +%right NOT 953 +%left '<' '>' '=' NE 954 LE 955 GE 956 %left '-' '+' %left '*' '/' -%right NEG 957 +%right NEG 958 %define api.prefix {ydf} %define api.token.prefix{YDF_} diff --git a/gcc/cobol/cobol1.cc b/gcc/cobol/cobol1.cc index 3146da5..77c457d 100644 --- a/gcc/cobol/cobol1.cc +++ b/gcc/cobol/cobol1.cc @@ -365,6 +365,7 @@ cobol_langhook_handle_option (size_t scode, return true; case OPT_fdefaultbyte: + // cobol_default_byte is an unsigned ing wsclear(cobol_default_byte); return true; diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc index 9d30dde..8c5f28a 100644 --- a/gcc/cobol/genapi.cc +++ b/gcc/cobol/genapi.cc @@ -863,8 +863,12 @@ function_pointer_from_name(const cbl_refer_t &name, NULL); // And, hence, no types // Fetch the FUNCTION_DECL for that FUNCTION_TYPE - tree function_decl = gg_build_fn_decl(name.field->data.initial, + char *tname = static_cast<char *>(xmalloc(name.field->data.capacity+1)); + memcpy(tname, name.field->data.original(), name.field->data.capacity); + tname[name.field->data.capacity] = '\0'; + tree function_decl = gg_build_fn_decl(tname, fndecl_type); + free(tname); // Take the address of the function decl: tree address_of_function = gg_get_address_of(function_decl); gg_assign(function_pointer, address_of_function); @@ -877,11 +881,11 @@ function_pointer_from_name(const cbl_refer_t &name, gg_assign(function_pointer, gg_cast(build_pointer_type(function_type), gg_call_expr( VOID_P, - "__gg__function_handle_from_literal", - build_int_cst_type(INT, - current_function->our_symbol_table_index), - gg_string_literal(name.field->data.initial), - NULL_TREE))); + "__gg__function_handle_from_literal", + build_int_cst_type(INT, + current_function->our_symbol_table_index), + gg_string_literal(name.field->data.original()), + NULL_TREE))); } else { @@ -919,7 +923,7 @@ parser_initialize_programs( size_t nprogs, if( progs[i].field->type == FldLiteralA ) { SHOW_PARSE_TEXT("\"") - SHOW_PARSE_TEXT(progs[i].field->data.initial) + SHOW_PARSE_TEXT(progs[i].field->data.original()) SHOW_PARSE_TEXT("\"") } else @@ -2246,21 +2250,19 @@ cobol_compare( tree return_int, { // Comparing a FldLiteralN to an alphanumeric - // CONVERSION ALERT. lefty->field->data.initial is an ASCII - // string. We want to convert it to the same encoding as the - // right side. - - cbl_encoding_t enc_left = DEFAULT_CHARMAP_SOURCE; - cbl_encoding_t enc_right = - static_cast<cbl_encoding_t>(righty->field->codeset.encoding); - + // This next conversion may be overkill. But just in case + // the encodings of the two variables are different, we are + // going to convert left-side text to the right-side encoding + cbl_encoding_t enc_left = lefty->field->codeset.encoding; + cbl_encoding_t enc_right = righty->field->codeset.encoding; size_t outlength; - char *converted = __gg__iconverter(enc_left, - enc_right, - lefty->field->data.initial, - strlen(lefty->field->data.initial)+1, - &outlength ); - + size_t inlength = strlen(lefty->field->data.initial); + char *converted = __gg__iconverter( + enc_left, + enc_right, + lefty->field->data.initial, + inlength, + &outlength ); gg_assign( return_int, gg_call_expr( INT, "__gg__literaln_alpha_compare", @@ -2458,7 +2460,7 @@ move_tree( cbl_field_t *dest, gg_call(VOID, "__gg__string_to_alpha_edited", location, - build_int_cst_type(INT, DEFAULT_CHARMAP_SOURCE), + build_int_cst_type(INT, DEFAULT_SOURCE_ENCODING), psz_source, min_length, member(dest->var_decl_node, "picture"), @@ -3956,7 +3958,7 @@ parser_enter_program( const char *funcname_, if( strcmp(funcname_, "main") == 0 && this_module_has_main ) { - // setting 'retval' to 1 let's the caller know that we are being told + // Setting 'retval' to 1 lets the caller know that we are being told // both to synthesize a main() entry point to duplicate GCC's default // behavior, and to create an explicit entry point named "main". This will // eventually result in a link error (because of the duplicated entry @@ -4164,178 +4166,197 @@ parser_init_list() gg_call(VOID, "__gg__variables_to_init", gg_get_address_of(array), - wsclear() ? gg_string_literal(wsclear()) : null_pointer_node, + wsclear() ? build_string_literal(1, (const char *)wsclear()) + : null_pointer_node, NULL_TREE); } -static void -psa_FldLiteralN(struct cbl_field_t *field ) +static +FIXED_WIDE_INT(128) +dirty_to_binary(const char *instring, + uint32_t &capacity, + uint32_t &digits, + int32_t &rdigits, + uint64_t &attr) { - Analyze(); - SHOW_PARSE - { - SHOW_PARSE_HEADER - SHOW_PARSE_FIELD(" ", field) - SHOW_PARSE_END - } - // We are constructing a completely static constant structure, based on the - // text string in .initial - - CHECK_FIELD(field); + digits = 0; + rdigits = 0; + attr = 0; FIXED_WIDE_INT(128) value = 0; - do + // We need to convert data.initial to an FIXED_WIDE_INT(128) value + const char *p = instring; + int sign = 1; + if( *p == '-' ) { - // This is a false do{}while, to isolate the variables: + attr |= signable_e; + sign = -1; + p += 1; + } + else if( *p == '+' ) + { + // We set it signable so that the instruction DISPLAY +1 + // actually outputs "+1" + attr |= signable_e; + p += 1; + } - // We need to convert data.initial to an FIXED_WIDE_INT(128) value - char *p = const_cast<char *>(field->data.initial); - int sign = 1; - if( *p == '-' ) - { - field->attr |= signable_e; - sign = -1; - p += 1; - } - else if( *p == '+' ) - { - // We set it signable so that the instruction DISPLAY +1 - // actually outputs "+1" - field->attr |= signable_e; - p += 1; - } + // We need to be able to handle + // 123 + // 123.456 + // 123E<exp> + // 123.456E<exp> + // where <exp> can be N, +N and -N + // + // Oh, yeah, and we're talking handling up to 32 digits, or more, so using + // library routines is off the table. + + int rdigit_delta = 0; + int exponent = 0; + const char *exp = strchr(p, 'E'); + if( !exp ) + { + exp = strchr(p, 'e'); + } + if(exp) + { + exponent = atoi(exp+1); + } - // We need to be able to handle - // 123 - // 123.456 - // 123E<exp> - // 123.456E<exp> - // where <exp> can be N, +N and -N - // - // Oh, yeah, and we're talking handling up to 32 digits, or more, so using - // library routines is off the table. + // We can now calculate the value, and the number of digits and rdigits. - int digits = 0; - int rdigits = 0; - int rdigit_delta = 0; - int exponent = 0; + // We count up leading zeroes as part of the attr->digits calculation. + // It turns out that certain comparisons need to know the number of digits, + // because "IF "2" EQUAL 002" is false, while "IF "2" EQUAL 2" is true. So, + // we need to count up leading zeroes. - const char *exp = strchr(p, 'E'); - if( !exp ) + for(;;) + { + char ch = *p++; + if( ch == symbol_decimal_point() ) { - exp = strchr(p, 'e'); + rdigit_delta = 1; + continue; } - if(exp) + if( ch < '0' || ch > '9' ) { - exponent = atoi(exp+1); + break; } + digits += 1; + rdigits += rdigit_delta; + value *= 10; + value += ch - '0'; + } - // We can now calculate the value, and the number of digits and rdigits. - - // We count up leading zeroes as part of the attr->digits calculation. - // It turns out that certain comparisons need to know the number of digits, - // because "IF "2" EQUAL 002" is false, while "IF "2" EQUAL 2" is true. So, - // we need to count up leading zeroes. - - for(;;) + if( exponent < 0 ) + { + rdigits += -exponent; + } + else + { + while(exponent--) { - char ch = *p++; - if( ch == symbol_decimal_point() ) + if(rdigits) { - rdigit_delta = 1; - continue; + rdigits -= 1; } - if( ch < '0' || ch > '9' ) + else { - break; + digits += 1; + value *= 10; } - digits += 1; - rdigits += rdigit_delta; - value *= 10; - value += ch - '0'; } + } - if( exponent < 0 ) - { - rdigits += -exponent; - } - else - { - while(exponent--) - { - if(rdigits) - { - rdigits -= 1; - } - else - { - digits += 1; - value *= 10; - } - } - } + if( (int32_t)digits < rdigits ) + { + digits = rdigits; + } - if(digits < rdigits) - { - digits = rdigits; - } - field->data.digits = digits; - field->data.rdigits = rdigits; + // We now need to calculate the capacity. - // We now need to calculate the capacity. + unsigned int min_prec = wi::min_precision(value, UNSIGNED); + if( min_prec > 64 ) + { + // Bytes 15 through 8 are non-zero + capacity = 16; + } + else if( min_prec > 32 ) + { + // Bytes 7 through 4 are non-zero + capacity = 8; + } + else if( min_prec > 16 ) + { + // Bytes 3 and 2 + capacity = 4; + } + else if( min_prec > 8 ) + { + // Byte 1 is non-zero + capacity = 2; + } + else + { + // The value is zero through 0xFF + capacity = 1; + } - unsigned int min_prec = wi::min_precision(value, UNSIGNED); - int capacity; - if( min_prec > 64 ) - { - // Bytes 15 through 8 are non-zero - capacity = 16; - } - else if( min_prec > 32 ) - { - // Bytes 7 through 4 are non-zero - capacity = 8; - } - else if( min_prec > 16 ) - { - // Bytes 3 and 2 - capacity = 4; - } - else if( min_prec > 8 ) + value *= sign; + + // One last adjustment. The number is signable, so the binary value + // is going to be treated as twos complement. That means that the highest + // bit has to be 1 for negative signable numbers, and 0 for positive. If + // necessary, adjust capacity up by one byte so that the variable fits: + + if( capacity < 16 && (attr & signable_e) ) + { + FIXED_WIDE_INT(128) mask + = wi::set_bit_in_zero<FIXED_WIDE_INT(128)>(capacity * 8 - 1); + if( wi::neg_p (value) && (value & mask) == 0 ) { - // Byte 1 is non-zero - capacity = 2; + capacity *= 2; } - else + else if( !wi::neg_p (value) && (value & mask) != 0 ) { - // The value is zero through 0xFF - capacity = 1; + capacity *= 2; } + } - value *= sign; + return value; + } - // One last adjustment. The number is signable, so the binary value - // is going to be treated as twos complement. That means that the highest - // bit has to be 1 for negative signable numbers, and 0 for positive. If - // necessary, adjust capacity up by one byte so that the variable fits: +static void +psa_FldLiteralN(struct cbl_field_t *field ) + { + Analyze(); + SHOW_PARSE + { + SHOW_PARSE_HEADER + SHOW_PARSE_FIELD(" ", field) + SHOW_PARSE_END + } + // We are constructing a completely static constant structure, based on the + // text string in .initial - if( capacity < 16 && (field->attr & signable_e) ) - { - FIXED_WIDE_INT(128) mask - = wi::set_bit_in_zero<FIXED_WIDE_INT(128)>(capacity * 8 - 1); - if( wi::neg_p (value) && (value & mask) == 0 ) - { - capacity *= 2; - } - else if( !wi::neg_p (value) && (value & mask) != 0 ) - { - capacity *= 2; - } - } - field->data.capacity = capacity; + CHECK_FIELD(field); - }while(0); + uint32_t capacity; + uint32_t digits; + int32_t rdigits; + uint64_t attr; + FIXED_WIDE_INT(128) value = dirty_to_binary(field->data.original(), + capacity, + digits, + rdigits, + attr); + // This is a rare occurrence of a parser_xxx call changing the entry + // in the symbol table. + field->data.capacity = capacity; + field->data.digits = digits; + field->data.rdigits = rdigits; + field->attr |= attr; char base_name[257]; char id_string[32] = ""; @@ -5136,9 +5157,9 @@ parser_alphabet( const cbl_alphabet_t& alphabet ) // character i has the ordinal alphabet[i] unsigned char ch = i; - ach[ch] = (alphabet.alphabet[i]); + ach[ch] = (alphabet.collation_sequence[i]); gg_assign( gg_array_value(table256, ch), - build_int_cst_type(UCHAR, (alphabet.alphabet[i])) ); + build_int_cst_type(UCHAR, (alphabet.collation_sequence[i])) ); } unsigned int low_char = alphabet.low_char; @@ -6811,7 +6832,7 @@ parser_allocate(cbl_refer_t size_or_based, cbl_field_t *f_working = current_options().initial_working(); cbl_field_t *f_local = current_options().initial_local(); - int default_byte = wsclear() ? *wsclear() : -1; + unsigned int default_byte = wsclear() ? *wsclear() : (uint32_t)(-1); gg_call(VOID, "__gg__allocate", @@ -8201,7 +8222,7 @@ parser_label_label(struct cbl_label_t *label) } CHECK_LABEL(label); - + #if 1 // At the present time, label_verify.lay is returning true, so I edited // out the if( !... ) to quiet cppcheck @@ -8252,7 +8273,7 @@ parser_label_goto(struct cbl_label_t *label) } CHECK_LABEL(label); - + label_verify.go_to(label); label_verify.go_to(label); @@ -9933,6 +9954,44 @@ parser_file_open( size_t nfiles, struct cbl_file_t *files[], int mode_char ) } } +static +tree get_the_filename(bool "ed_name, const cbl_file_t *file) + { + // The cbl_file_t has a cbl_field_t *filename. This can be a FldAlphanumeric. + // The runtime has a (char *)filename, so we need to + // do a runtime conversion. + + tree psz; // This is going to be either the name of the file, or the + // possible run-time environment variable that will contain + // the name of the file. + + cbl_field_t *field_of_name = symbol_field_forward(file->filename); + quoted_name = false; + if( field_of_name->type == FldForward ) + { + // The target of ASSIGN TO was unquoted, but didn't resolve to a + // cbl_field_t. This means that the name of the field is an + // environment variable that will hold the file name + psz = gg_define_char_star(); + gg_assign(psz, gg_strdup(gg_string_literal(field_of_name->name))); + } + else + { + // The name is coming from a presumably FldAlphaNumeric variable + psz = get_string_from(field_of_name); + gg_call( CHAR_P, + "__gg__convert_encoding", + psz, + build_int_cst_type(INT, + field_of_name->codeset.encoding), + build_int_cst_type(INT, + DEFAULT_SOURCE_ENCODING), + NULL_TREE); + quoted_name = true; + } + return psz; + } + void parser_file_open( struct cbl_file_t *file, int mode_char ) { @@ -9985,45 +10044,15 @@ parser_file_open( struct cbl_file_t *file, int mode_char ) TRACE1_END } - // The cbl_file_t has a cbl_field_t *filename. This can be a FldAlphanumeric. - // The runtime has a (char *)filename, so we need to - // do a runtime conversion. - - tree psz; // This is going to be either the name of the file, or the - // possible run-time environment variable that will contain - // the name of the file. - - cbl_field_t *field_of_name = symbol_field_forward(file->filename); - bool quoted_name = false; - if( field_of_name->type == FldForward ) - { - // The target of ASSIGN TO was unquoted, but didn't resolve to a - // cbl_field_t. This means that the name of the field is an - // environment variable that will hold the file name - psz = gg_define_char_star(); - gg_assign(psz, gg_strdup(gg_string_literal(field_of_name->name))); - } - else - { - // The name is coming from a presumably FldAlphaNumeric variable - psz = get_string_from(field_of_name); - gg_call( CHAR_P, - "__gg__convert_encoding", - psz, - build_int_cst_type(INT, - field_of_name->codeset.encoding), - build_int_cst_type(INT, - DEFAULT_CHARMAP_SOURCE), - NULL_TREE); - quoted_name = true; - } + bool quoted_name; + tree pszFilename = get_the_filename(quoted_name, file); sv_is_i_o = true; store_location_stuff("OPEN"); gg_call(VOID, "__gg__file_open", gg_get_address_of(file->var_decl_node), - psz, + pszFilename, build_int_cst_type(INT, mode_char), quoted_name ? integer_one_node : integer_zero_node, NULL_TREE); @@ -10384,6 +10413,121 @@ parser_file_delete( struct cbl_file_t *file, bool /*sequentially*/ ) } } +static void +set_up_delete_file_label(cbl_label_t *delete_file_label) + { + if( delete_file_label ) + { + if( !delete_file_label->structs.delete_file ) + { + delete_file_label->structs.delete_file + = static_cast<cbl_delete_file_t *> + (xmalloc(sizeof(struct cbl_delete_file_t))); + // Set up the address pairs for this clause + gg_create_goto_pair( + &delete_file_label->structs.delete_file->over.go_to, + &delete_file_label->structs.delete_file->over.label); + gg_create_goto_pair( + &delete_file_label->structs.delete_file->exception.go_to, + &delete_file_label->structs.delete_file->exception.label); + gg_create_goto_pair( + &delete_file_label->structs.delete_file->no_exception.go_to, + &delete_file_label->structs.delete_file->no_exception.label); + gg_create_goto_pair( + &delete_file_label->structs.delete_file->bottom.go_to, + &delete_file_label->structs.delete_file->bottom.label); + } + } + } + +void +parser_file_delete_file( cbl_label_t *name, + std::vector<cbl_file_t*> filenames ) + { + // This removes a file from the file system. It is distinct from the + // FILE DELETE statement, which deletes a record from a file. + SHOW_PARSE + { + SHOW_PARSE_HEADER + SHOW_PARSE_TEXT(" "); + SHOW_PARSE_TEXT(name->name); + for(size_t i=0; i<filenames.size(); i++) + { + SHOW_PARSE_INDENT + SHOW_PARSE_TEXT(filenames[i]->name) + } + SHOW_PARSE_END + } + set_up_delete_file_label(name); + tree there_was_an_error = gg_define_int(0); + for(size_t i=0; i<filenames.size(); i++) + { + bool quoted_name; + tree pszFilename = get_the_filename(quoted_name, filenames[i]); + gg_assign(there_was_an_error, + gg_bitwise_or(there_was_an_error, + gg_call_expr( + INT, + "__gg__file_remove", + gg_get_address_of(filenames[i]->var_decl_node), + pszFilename, + quoted_name ? integer_one_node : integer_zero_node, + NULL_TREE))); + set_user_status(filenames[i]); + } + IF( there_was_an_error, eq_op, integer_zero_node ) + { + // There was no error detected. + gg_append_statement(name->structs.delete_file->no_exception.go_to); + } + ELSE + { + // There was an error detected. + gg_append_statement(name->structs.delete_file->exception.go_to); + } + } + +void +parser_file_delete_on_exception( cbl_label_t *name ) + { + SHOW_PARSE + { + SHOW_PARSE_HEADER + SHOW_PARSE_TEXT(" "); + SHOW_PARSE_TEXT(name->name); + SHOW_PARSE_END + } + gg_append_statement(name->structs.delete_file->bottom.go_to); + gg_append_statement(name->structs.delete_file->exception.label); + } + +void +parser_file_delete_not_exception( cbl_label_t *name ) + { + SHOW_PARSE + { + SHOW_PARSE_HEADER + SHOW_PARSE_TEXT(" "); + SHOW_PARSE_TEXT(name->name); + SHOW_PARSE_END + } + gg_append_statement(name->structs.delete_file->bottom.go_to); + gg_append_statement(name->structs.delete_file->no_exception.label); + } + +void +parser_file_delete_end( cbl_label_t *name ) + { + SHOW_PARSE + { + SHOW_PARSE_HEADER + SHOW_PARSE_TEXT(" "); + SHOW_PARSE_TEXT(name->name); + SHOW_PARSE_END + } + gg_append_statement(name->structs.delete_file->bottom.label); + } + void parser_file_rewrite(cbl_file_t *file, cbl_field_t *record_area, @@ -13639,7 +13783,7 @@ parser_call( cbl_refer_t name, create_and_call(narg, args, NULL_TREE, - name.field->data.initial, + name.field->data.original(), returned_value_type, returned, not_except); @@ -13747,7 +13891,7 @@ parser_entry( const cbl_field_t *name, size_t nusing, cbl_ffi_arg_t *args ) { SHOW_PARSE_HEADER SHOW_PARSE_TEXT(" ") - SHOW_PARSE_TEXT(name->data.initial) + SHOW_PARSE_TEXT(name->data.original()) SHOW_PARSE_END } @@ -13756,7 +13900,7 @@ parser_entry( const cbl_field_t *name, size_t nusing, cbl_ffi_arg_t *args ) // Get the name of the ENTRY point. // cppcheck-suppress nullPointerRedundantCheck - char *psz = cobol_name_mangler(name->data.initial); + char *psz = cobol_name_mangler(name->data.original()); // Create a goto/label pair. The label will be set up here; the goto will // be used when we re-enter the containing function: @@ -14642,13 +14786,12 @@ mh_source_is_literalN(cbl_refer_t &destref, SHOW_PARSE_TEXT("mh_source_is_literalN: __gg__psz_to_alpha_move") } - // We know that the encoding of the literal::initial is in ASCII - // We need the data sent to __gg__psz_to_alpha_move to be in the // encoding of the destination size_t charsout; - const char *converted = __gg__iconverter(DEFAULT_CHARMAP_SOURCE, + const char *converted = __gg__iconverter( + sourceref.field->codeset.encoding, destref.field->codeset.encoding, sourceref.field->data.initial, strlen(sourceref.field->data.initial), @@ -16086,54 +16229,50 @@ real_powi10 (uint32_t x) return pow10; } +static char * -binary_initial_from_float128(cbl_field_t *field, int rdigits, - REAL_VALUE_TYPE value) +binary_initial(cbl_field_t *field) { // This routine returns an xmalloced buffer designed to replace the // data.initial member of the incoming field char *retval = NULL; - // We need to adjust value so that it has no decimal places - if( rdigits ) + uint32_t capacity; + uint32_t ddigits; + int32_t drdigits; + uint64_t attr; + FIXED_WIDE_INT(128) value128 = dirty_to_binary(field->data.original(), + capacity, + ddigits, + drdigits, + attr); + int scaled_rdigits = get_scaled_rdigits(field); + + int i = field->data.rdigits; + while( i<0 ) { - REAL_VALUE_TYPE pow10 = real_powi10 (rdigits); - real_arithmetic (&value, MULT_EXPR, &value, &pow10); - real_convert (&value, TYPE_MODE (float128_type_node), &value); + value128 = value128/10; + i += 1; } - // We need to make sure that the resulting string will fit into - // a number with 'digits' digits - // Keep in mind that pure binary types, like BINARY-CHAR, have no digits - if( field->data.digits ) + // We take the digits of value128, and put them into ach. We line up + // the rdigits, and we truncate the string after desired_digits + while(drdigits < scaled_rdigits) { - REAL_VALUE_TYPE pow10 = real_powi10 (field->data.digits); - mpfr_t m0, m1; - - mpfr_inits2 (REAL_MODE_FORMAT (TYPE_MODE (float128_type_node))->p, - m0, m1, NULL); - mpfr_from_real (m0, &value, MPFR_RNDN); - mpfr_from_real (m1, &pow10, MPFR_RNDN); - mpfr_clear_flags (); - mpfr_fmod (m0, m0, m1, MPFR_RNDN); - real_from_mpfr (&value, m0, - REAL_MODE_FORMAT (TYPE_MODE (float128_type_node)), - MPFR_RNDN); - real_convert (&value, TYPE_MODE (float128_type_node), &value); - mpfr_clears (m0, m1, NULL); + value128 *= 10; + drdigits += 1; + } + while(drdigits > scaled_rdigits) + { + value128 = value128 / 10; + drdigits -= 1; } - - real_roundeven (&value, TYPE_MODE (float128_type_node), &value); - - bool fail = false; - FIXED_WIDE_INT(128) i - = FIXED_WIDE_INT(128)::from (real_to_integer (&value, &fail, 128), SIGNED); retval = static_cast<char *>(xmalloc(field->data.capacity)); gcc_assert(retval); switch(field->data.capacity) { - tree type; + tree type; case 1: case 2: case 4: @@ -16141,12 +16280,12 @@ binary_initial_from_float128(cbl_field_t *field, int rdigits, case 16: type = build_nonstandard_integer_type ( field->data.capacity * BITS_PER_UNIT, 0); - native_encode_wide_int (type, i, PTRCAST(unsigned char, retval), + native_encode_wide_int (type, value128, PTRCAST(unsigned char, retval), field->data.capacity); break; default: fprintf(stderr, - "Trouble in binary_initial_from_float128 at %s() %s:%d\n", + "Trouble in binary_initial at %s() %s:%d\n", __func__, __FILE__, __LINE__); @@ -16157,6 +16296,60 @@ binary_initial_from_float128(cbl_field_t *field, int rdigits, return retval; } +static void +digits_from_int128( char *ach, + cbl_field_t *field, + uint32_t desired_digits, + FIXED_WIDE_INT(128) value128, // cppcheck-suppress unknownMacro + int32_t rdigits) + { + if( value128 < 0 ) + { + value128 = -value128; + } + + // 'rdigits' are the number of rdigits in value128. + + int scaled_rdigits = get_scaled_rdigits(field); + + int i = field->data.rdigits; + while( i<0 ) + { + value128 = value128/10; + i += 1; + } + + // We take the digits of value128, and put them into ach. We line up + // the rdigits, and we truncate the string after desired_digits + while(rdigits < scaled_rdigits) + { + value128 *= 10; + rdigits += 1; + } + while(rdigits > scaled_rdigits) + { + value128 = value128 / 10; + rdigits -= 1; + } + char conv[128]; + print_dec (value128, conv, SIGNED); + size_t len = strlen(conv); + + if( len<desired_digits ) + { + memset(ach, ascii_0, desired_digits - len); + strcpy(ach+desired_digits - len, conv); + } + else + { + strcpy(ach, conv + len-desired_digits); + } + } + +#if 0 +// This routine was replaced with digits_from_int1289. However, I am choosing +// to keep it around for a while, because it is a master class in manipulating +// REAL_VALUE_TYPE and FIXED_WIDE_INT static void digits_from_float128(char *retval, cbl_field_t *field, size_t width, int rdigits, REAL_VALUE_TYPE value) @@ -16194,8 +16387,6 @@ digits_from_float128(char *retval, cbl_field_t *field, size_t width, int rdigits // We convert it to a integer string of digits: print_dec (i, ach, SIGNED); - //fprintf(stderr, "digits_from_float128() %s %f %s ", field->name, (double)value, ach); - gcc_assert( strlen(ach) <= field->data.digits ); if( strlen(ach) < width ) { @@ -16203,6 +16394,7 @@ digits_from_float128(char *retval, cbl_field_t *field, size_t width, int rdigits } strcpy(retval + (width-strlen(ach)), ach); } +#endif static char * initial_from_initial(cbl_field_t *field) @@ -16211,10 +16403,9 @@ initial_from_initial(cbl_field_t *field) // This routine returns an xmalloced buffer that is intended to replace the // data.initial member of the incoming field. - //fprintf(stderr, "initial_from_initial %s\n", field->name); + //fprintf(stderr, " %s\n", field->name); char *retval = NULL; - int rdigits; // Let's handle the possibility of a figurative constant cbl_figconst_t figconst = cbl_figconst_of(field->data.initial); @@ -16253,6 +16444,8 @@ initial_from_initial(cbl_field_t *field) if( field->data.etc_type == cbl_field_data_t::value_e ) value = TREE_REAL_CST (field->data.value_of ()); +#if 0 + int rdigits; // There is always the infuriating possibility of a P-scaled number if( field->attr & scaled_e ) { @@ -16288,17 +16481,18 @@ initial_from_initial(cbl_field_t *field) // Not P-scaled rdigits = field->data.rdigits; } +#endif switch(field->type) { case FldNumericBin5: case FldIndex: - retval = binary_initial_from_float128(field, rdigits, value); + retval = binary_initial(field); break; case FldNumericBinary: { - retval = binary_initial_from_float128(field, rdigits, value); + retval = binary_initial(field); size_t left = 0; size_t right = field->data.capacity - 1; while(left < right) @@ -16328,7 +16522,17 @@ initial_from_initial(cbl_field_t *field) negative = false; } - digits_from_float128(ach, field, field->data.digits, rdigits, value); + // Convert the data.initial to a __int128 + uint32_t capacity; + uint32_t ddigits; + int32_t drdigits; + uint64_t attr; + FIXED_WIDE_INT(128) value128 = dirty_to_binary(field->data.initial, + capacity, + ddigits, + drdigits, + attr); + digits_from_int128(ach, field, field->data.digits, value128, drdigits); const char *digits = ach; if( (field->attr & signable_e) @@ -16404,7 +16608,16 @@ initial_from_initial(cbl_field_t *field) size_t ndigits = (field->attr & separate_e) ? field->data.capacity * 2 : field->data.capacity * 2 - 1; - digits_from_float128(ach, field, ndigits, rdigits, value); + uint32_t capacity; + uint32_t ddigits; + int32_t drdigits; + uint64_t attr; + FIXED_WIDE_INT(128) value128 = dirty_to_binary(field->data.initial, + capacity, + ddigits, + drdigits, + attr); + digits_from_int128(ach, field, ndigits, value128, drdigits); const char *digits = ach; for(size_t i=0; i<ndigits; i++) @@ -16517,13 +16730,31 @@ initial_from_initial(cbl_field_t *field) else { size_t ndigits = field->data.capacity; - digits_from_float128(ach, field, ndigits, rdigits, value); - /* ??? This resides in libgcobol valconv.cc. */ + uint32_t capacity; + uint32_t ddigits; + int32_t drdigits; + uint64_t attr; + FIXED_WIDE_INT(128) value128 = dirty_to_binary(field->data.original(), + capacity, + ddigits, + drdigits, + attr); + digits_from_int128(ach, field, ndigits, value128, drdigits); + + // __gg__string_to_numeric_edited operates in ASCII space: __gg__string_to_numeric_edited( retval, ach, field->data.rdigits, negative, field->data.picture); + // So now we convert it to the target encoding: + size_t nbytes; + const char *converted = __gg__iconverter(DEFAULT_SOURCE_ENCODING, + field->codeset.encoding, + retval, + strlen(retval), + &nbytes); + strcpy(retval, converted); } } break; @@ -16556,10 +16787,32 @@ initial_from_initial(cbl_field_t *field) case FldLiteralN: { -//// retval = static_cast<char *>(xmalloc(field->data.capacity+1)); -//// gcc_assert(retval); -//// memcpy(retval, field->data.initial, field->data.capacity); -//// retval[field->data.capacity] = '\0'; + // This requires annotation. + + // The compiler originally used ASCII for field->data.initial. Later we + // expanded the field with the addition of the codeset.encoding + // For consistency in the parser processing, the FldLiteralN is arriving + // with the Object-Computer's character encoding, and field->data.initial + // is showing up encoded. + + // But on the run-time side, if the initial string is needed, it is + // invariably more useful in ASCII. Consider converting that string to + // a floating-point value, for example. + + // So, we are going to convert the data.initial string back to ASCII + // here. Later on, when we establish the run-time encoding, we will + // check for FldLiteralN and set that to ASCII as well. See + // actually_create_the_static_field(). + + size_t nbytes; + const char *converted = __gg__iconverter(field->codeset.encoding, + DEFAULT_SOURCE_ENCODING, + field->data.initial, + strlen(field->data.initial), + &nbytes); + retval = static_cast<char *>(xmalloc(strlen(field->data.initial)+1)); + gcc_assert(retval); + strcpy(retval, converted); break; } @@ -16716,9 +16969,14 @@ actually_create_the_static_field( cbl_field_t *new_var, next_field = TREE_CHAIN(next_field); // INT, "encoding", + // For FldLiteralN we force the encoding to be ASCII. + // See initial_from_initial() for an explanation. CONSTRUCTOR_APPEND_ELT(CONSTRUCTOR_ELTS(constr), next_field, - build_int_cst_type(INT, new_var->codeset.encoding)); + build_int_cst_type(INT, + new_var->type == FldLiteralN ? + DEFAULT_SOURCE_ENCODING + : new_var->codeset.encoding)); next_field = TREE_CHAIN(next_field); // INT, "alphabet", @@ -17643,6 +17901,10 @@ parser_symbol_add(struct cbl_field_t *new_var ) length_of_initial_string = new_var->data.capacity+1; break; + case FldLiteralN: + length_of_initial_string = strlen(new_initial)+1; + break; + default: length_of_initial_string = new_var->data.capacity; break; diff --git a/gcc/cobol/genapi.h b/gcc/cobol/genapi.h index 6582d2e..802bba7 100644 --- a/gcc/cobol/genapi.h +++ b/gcc/cobol/genapi.h @@ -400,6 +400,12 @@ parser_file_rewrite( cbl_file_t *file, cbl_field_t *field, void parser_file_delete( cbl_file_t *file, bool sequentially ); +void parser_file_delete_file( cbl_label_t *name, + std::vector<cbl_file_t*> filenames ); +void parser_file_delete_on_exception( cbl_label_t *name ); +void parser_file_delete_not_exception( cbl_label_t *name ); +void parser_file_delete_end( cbl_label_t *name ); + #if condition_lists struct cbl_conditional_t { cbl_field_t *tgt; diff --git a/gcc/cobol/genmath.cc b/gcc/cobol/genmath.cc index 320e6bf..7d6ae8c 100644 --- a/gcc/cobol/genmath.cc +++ b/gcc/cobol/genmath.cc @@ -42,6 +42,7 @@ #include "gengen.h" #include "structs.h" #include "../../libgcobol/gcobolio.h" +#include "../../libgcobol/charmaps.h" #include "show_parse.h" void diff --git a/gcc/cobol/genutil.cc b/gcc/cobol/genutil.cc index 56b6b83..63f37f6 100644 --- a/gcc/cobol/genutil.cc +++ b/gcc/cobol/genutil.cc @@ -1744,7 +1744,7 @@ get_literal_string(cbl_field_t *field) char *buffer = static_cast<char *>(xcalloc(1, buffer_length)); size_t charsout; - const char *converted = __gg__iconverter(DEFAULT_CHARMAP_SOURCE, + const char *converted = __gg__iconverter(DEFAULT_SOURCE_ENCODING, field->codeset.encoding, field->data.initial, field->data.capacity, diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y index 9187a59..d54a686 100644 --- a/gcc/cobol/parse.y +++ b/gcc/cobol/parse.y @@ -51,7 +51,7 @@ accept_envar_e, }; - struct collating_an_t { + struct coll_alphanat_t { const char *alpha, *national; }; @@ -575,7 +575,7 @@ class locale_tgt_t { RD RECORD RECORDING RECORDS RECURSIVE REDEFINES REEL REFERENCE RELATIVE REM REMAINDER REMARKS REMOVAL RENAMES REPLACE REPLACING REPORT REPORTING REPORTS - REPOSITORY RERUN RESERVE RESTRICTED RESUME + REPOSITORY RERUN RESERVE RESTRICTED RESUME RETRY REVERSE REVERSED REWIND RF RH RIGHT ROUNDED RUN SAME SCREEN SD @@ -702,8 +702,8 @@ class locale_tgt_t { %type <number> open_io alphabet_etc %type <special_type> device_name %type <string> numed context_word ctx_name locale_spec -%type <collating_sequences> collating_sequences collating_ans -%type <collating_name> collating_an +%type <char_class_locales> char_class_locales coll_alphanats +%type <collating_name> coll_alphanat %type <literal> namestr alphabet_lit program_as repo_as %type <field> perform_cond kind_of_name %type <refer> alloc_ret @@ -738,6 +738,9 @@ class locale_tgt_t { relative_key_clause reserve_clause sharing_clause %type <file> filename read_body write_body delete_body +%type <label> delete_file_body +%type <error> delete_error delete_except delete_excepts + %type <file> start_impl start_cond start_body %type <rewrite_t> rewrite_body %type <min_max> record_vary rec_contains from_to record_desc @@ -833,6 +836,7 @@ class locale_tgt_t { global is_global anycase backward end_display exh_changed exh_named + override %type <number> mistake globally first_last %type <io_mode> io_mode @@ -874,6 +878,7 @@ class locale_tgt_t { %type <opt_init_sect> opt_init_sect %type <number> opt_init_value %type <number> locale_current loc_category user_default +%type <string> locale_name %type <token_list> loc_categories locale_tgt %type <opt_round> rounded round_between rounded_type rounded_mode %type <opt_arith> opt_arith_type @@ -901,7 +906,7 @@ class locale_tgt_t { struct { YYLTYPE loc; int token; literal_t name; } prog_end; struct { int token; special_name_t id; } special_type; struct { char locale_type; const char * name; } locale_phrase; - collating_an_t collating_sequences; + coll_alphanat_t char_class_locales; struct collating_name_t { int token; const char *name; } collating_name; struct { size_t isym; cbl_encoding_t encoding; } codeset; struct { cbl_field_type_t type; @@ -2371,6 +2376,23 @@ config_paragraphs: config_paragraph config_paragraph: SPECIAL_NAMES '.' | SPECIAL_NAMES '.' special_names '.' + { + std::reverse_iterator<symbol_elem_t *> + p(symbols_end()), + pend(symbols_begin(PROGRAM)); + for( ++p; p != pend; p++ ) { + if( p->type == SymAlphabet ) { + const auto& alphabet = *cbl_alphabet_of(&*p); + if( alphabet.encoding == no_encoding_e ) { + assert(alphabet.locale != 0 ); + const auto& missing = *cbl_locale_of(symbol_at(alphabet.locale)); + error_msg(alphabet.loc, + "ALPHABET %qs references LOCALE %qs, which is not defined", + alphabet.name, missing.name); + } + } + } + } | SOURCE_COMPUTER '.' | SOURCE_COMPUTER '.' NAME '.' | SOURCE_COMPUTER '.' NAME with_debug '.' @@ -2507,19 +2529,36 @@ with_debug: with DEBUGGING MODE { ; collations: %empty - | collation_classification - | collation_sequence - | collation_classification collation_sequence - | collation_sequence collation_classification + | char_classification + | collating_sequence + | char_classification collating_sequence + | collating_sequence char_classification ; -collation_classification: - character CLASSIFICATION collating_sequences[seq] +char_classification: + character CLASSIFICATION char_class_locales[seq] { - warn_msg(@seq, "CHARACTER CLASSIFICATION ignored"); + if( $seq.alpha ) { + auto e = symbol_locale(PROGRAM, $seq.alpha); + if( !e ) { + error_msg(@seq, "no LOCALE defined as %qs", $seq.alpha); + } else { + auto& encoding = cbl_locale_of(e)->encoding; + current.alpha_encoding(symbol_index(e), encoding); + } + } + if( $seq.national ) { + auto e = symbol_locale(PROGRAM, $seq.national); + if( !e ) { + error_msg(@seq, "no LOCALE defined as %qs", $seq.national); + } else { + auto& encoding = cbl_locale_of(e)->encoding; + current.national_encoding(symbol_index(e), encoding); + } + } } ; -collation_sequence: - program_kw collating SEQUENCE collating_sequences[seq] +collating_sequence: + program_kw collating SEQUENCE char_class_locales[seq] { if( !current.collating_sequence($seq.alpha) ) { error_msg(@seq, "collating sequence already defined as '%s'", @@ -2529,20 +2568,20 @@ collation_sequence: } ; -collating_sequences: +char_class_locales: is NAME[name] { $$.alpha = $name; $$.national = nullptr; } - | collating_ans { $$ = $1; } + | coll_alphanats { $$ = $1; } ; -collating_ans: collating_an[encoding] { - $$ = collating_an_t(); +coll_alphanats: coll_alphanat[encoding] { + $$ = coll_alphanat_t(); const char **pname = $encoding.token == ALPHANUMERIC? &$$.alpha : &$$.national; *pname = $encoding.name; } - | collating_ans collating_an[encoding] + | coll_alphanats coll_alphanat[encoding] { const char **pname = $encoding.token == ALPHANUMERIC? &$$.alpha : &$$.national; @@ -2553,7 +2592,7 @@ collating_ans: collating_an[encoding] { *pname = $encoding.name; } ; -collating_an: for alphanational is locale_phrase[locale] { +coll_alphanat: for alphanational is locale_phrase[locale] { $$.token = $alphanational; $$.name = $locale.name; if( ! $locale.name ) { @@ -2568,7 +2607,6 @@ collating_an: for alphanational is locale_phrase[locale] { keyword_str($$.token), locale_name); } - warn_msg(@locale, "LOCALE phrase ignored"); } ; @@ -2643,9 +2681,20 @@ special_name: dev_mnemonic { symbol_decimal_point_set(','); } - | LOCALE NAME is locale_spec[spec] { - current.locale($NAME, $spec); - cbl_unimplementedw("sorry, unimplemented: LOCALE %qs", $spec); + | LOCALE NAME is locale_spec[spec] + { + cbl_locale_t locale($NAME, $spec); + if( locale.encoding == no_encoding_e ) { + error_msg(@NAME, "invalid iconv LOCALE name %qs", $spec); + YYERROR; + } + if( locale.encoding == UTF8_e ) { + cbl_unimplemented("UTF-8"); + YYERROR; + } + if( ! current.locale_add(locale) ) { + error_msg(@NAME, "%qs already defined as LOCALE name", $NAME); + } } ; | upsi @@ -2655,6 +2704,8 @@ special_name: dev_mnemonic } ; locale_spec: NAME { $$ = $1; } + | UTF_8 { static char s[] ="UTF-8"; $$ = s; } + | UTF_16 { static char s[] ="UTF-16"; $$ = s; } | LITERAL { $$ = string_of($1); } ; @@ -2746,14 +2797,16 @@ device_name: SYSIN { $$.token = SYSIN; $$.id = SYSIN_e; } alphabet_name: STANDARD_ALPHABET { $$ = alphabet_add(@1, CP1252_e); } | NATIVE { $$ = alphabet_add(@1, EBCDIC_e); } | EBCDIC { $$ = alphabet_add(@1, EBCDIC_e); } - | LOCALE ctx_name + | LOCALE locale_name[name] { - auto e = symbol_alphabet(PROGRAM, $ctx_name); + auto e = symbol_locale(PROGRAM, $name); if( !e ) { - error_msg(@ctx_name, "no such ALPHABET %qs", $ctx_name); - YYERROR; - } - $$ = cbl_alphabet_of(e); + dbgmsg("no such LOCALE yet %s", $name); + cbl_locale_t locale($name); // locale is named but not defined + e = symbol_locale_add(PROGRAM, &locale); + } + cbl_alphabet_t alphabet( @name, symbol_index(e), $name); + $$ = alphabet_add(alphabet); } | alphabet_seqs { @@ -3592,7 +3645,7 @@ const_value: cce_expr value78: literalism { - cbl_field_data_t data = {}; + cbl_field_data_t data; data.capacity = capacity_cast(strlen($1.data)); data.initial = $1.data; $$.encoding = $1.encoding; @@ -3600,13 +3653,15 @@ value78: literalism } | const_value { - cbl_field_data_t data = {}; + cbl_field_data_t data; data = build_real (float128_type_node, $1); + $$.encoding = current_encoding('A'); $$.data = new cbl_field_data_t(data); } | reserved_value[value] { const auto field = constant_of(constant_index($value)); + $$.encoding = current_encoding('A'); $$.data = new cbl_field_data_t(field->data); } @@ -3638,6 +3693,7 @@ data_descr1: level_name field.type = FldLiteralN; field.data = build_real (float128_type_node, $const_value); field.data.initial = string_of($const_value); + field.codeset.set(); if( !cdf_value(field.name, cdfval_t($const_value)) ) { error_msg(@1, "%s was defined by CDF", field.name); @@ -3674,13 +3730,12 @@ data_descr1: level_name if( !cdf_value(field.name, $lit.data) ) { error_msg(@1, "%s was defined by CDF", field.name); } - if( ! field.codeset.valid() ) { - if( ! field.codeset.set(field.codeset.standard_internal.type) ) { - error_msg(@lit, "CONSTANT inconsistent with encoding %s", - cbl_alphabet_t::encoding_str(field.codeset.encoding)); - } + if( ! field.codeset.set() ) { + error_msg(@lit, "CONSTANT inconsistent with encoding %s", + cbl_alphabet_t::encoding_str(field.codeset.encoding)); } - value_encoding_check(@lit, $1, $lit.encoding); + + value_encoding_check(@lit, $1); } | level_name CONSTANT is_global FROM NAME { @@ -3718,6 +3773,7 @@ data_descr1: level_name } else { field.type = FldLiteralN; field.data.initial = string_of(field.data.value_of()); + field.codeset.set($data.encoding); if( !cdf_value(field.name, field.as_integer()) ) { yywarn("%s was defined by CDF", field.name); } @@ -3975,6 +4031,15 @@ data_descr1: level_name // Verify VALUE $field->report_invalid_initial_value(@data_clauses); + bool numerical = + $field->type == FldNumericDisplay || is_numeric($field); + + if( $field->data.initial && ! numerical ) { + if( normal_value_e == cbl_figconst_of($field->data.initial) ) { + value_encoding_check(@data_clauses, $field); + } + } + // verify REDEFINES const auto parent = parent_of($field); if( parent && $field->level == parent->level ) { @@ -4287,14 +4352,16 @@ picture_clause: PIC signed nps[fore] nines nps[aft] if( field->data.initial != NULL ) { if( 0 < field->data.capacity && field->data.capacity < uint32_t($size) ) { - auto p = blank_pad_initial( field->data.initial, - field->data.capacity, $size ); + auto p = blank_pad_initial(field->data.initial, + field->data.capacity, $size ); if( !p ) YYERROR; field->data.initial = p; } } - field->data.capacity = $size; + charmap_t *charmap = + __gg__get_charmap(field->codeset.encoding); + field->data.capacity = $size * charmap->stride(); field->data.picture = NULL; if( false ) dbgmsg("PIC alphanum_pic[size]:%d: %s", @@ -4708,14 +4775,23 @@ usage_clause1: usage BIT value_clause: VALUE all LITERAL[lit] { cbl_field_t *field = current_field(); - if( ! field->codeset.set($lit.encoding) ) { - error_msg(@lit, "VALUE inconsistent with encoding %s", - cbl_alphabet_t::encoding_str(field->codeset.encoding)); + + if( $lit.prefix[0] ) { // not the default encoding + if( ! field->codeset.set($lit.encoding) ) { + error_msg(@lit, "VALUE inconsistent with encoding %s", + cbl_alphabet_t::encoding_str(field->codeset.encoding)); + } + } else { + field->codeset.set(); } + + if( field->codeset.encoding != $lit.encoding ) { + error_msg(@lit, "PICTURE inconsistent with VALUE %s'%s'", + $lit.prefix, $lit.data); + } + field->data.initial = $lit.data; field->attr |= literal_attr($lit.prefix); - // The __gg__initialize_data routine needs to know that VALUE is a - // quoted literal. This is critical for NumericEdited variables field->attr |= quoted_e; if( field->data.capacity == 0 ) { @@ -4732,7 +4808,6 @@ value_clause: VALUE all LITERAL[lit] { } } } - value_encoding_check(@lit, field, $lit.encoding); } | VALUE all cce_expr[value] { cbl_field_t *field = current_field(); @@ -4761,11 +4836,9 @@ value_clause: VALUE all LITERAL[lit] { | VALUE all reserved_value[value] { cbl_field_t *field = current_field(); - if( ! field->codeset.valid() ) { - if( ! field->codeset.set(field->codeset.standard_internal.type) ) { - error_msg(@value, "VALUE inconsistent with encoding %s", - cbl_alphabet_t::encoding_str(field->codeset.encoding)); - } + if( ! field->codeset.set() ) { + error_msg(@value, "VALUE inconsistent with encoding %s", + cbl_alphabet_t::encoding_str(field->codeset.encoding)); } if( $value != NULLS ) { auto fig = constant_of(constant_index($value)); @@ -5017,6 +5090,7 @@ typedef_clause: is TYPEDEF strong error_msg(@2, "%s %s IS TYPEDEF must be level 01", field->level_str(), field->name); } + field->codeset.set(); field->attr |= typedef_e; if( $strong ) field->attr |= strongdef_e; if( ! current.typedef_add(field) ) { @@ -7007,6 +7081,8 @@ context_word: APPLY { static char s[] ="APPLY"; $$ = s; } // LOCK MODE clause | MULTIPLE { static char s[] ="MULTIPLE"; $$ = s; } // LOCK ON phrase + | NAT { static char s[] ="NAT"; + $$ = s; } // CONVERT function | NEAREST_AWAY_FROM_ZERO { static char s[] ="NEAREST-AWAY-FROM-ZERO"; $$ = s; } // INTERMEDIATE ROUNDING clause and ROUNDED phrase | NEAREST_EVEN { static char s[] ="NEAREST-EVEN"; @@ -8544,7 +8620,7 @@ advance_by: scalar lines { $$ = $1; } /* BUG: should accept reference */ * number of lines is negative. So, we use the * negative Number Of The Beast as a PAGE flag. */ - $$ = new_reference( new_literal("-666") ); + $$ = new_reference( new_literal(xstrdup("-666")) ); } | device_name { $$ = new_reference(literally_one); } ; @@ -8601,7 +8677,33 @@ io_invalid: INVALID key { delete: delete_impl end_delete | delete_cond end_delete + | delete_file end_delete ; +delete_file: DELETE delete_file_body[stmt] delete_error[err] { + if( ! $err.on_error ) parser_file_delete_on_exception($stmt); + if( ! $err.not_error ) parser_file_delete_not_exception($stmt); + parser_file_delete_end($stmt); + current.declaratives_evaluate(); + } +delete_file_body: + FILE_KW override filenames retry_phrase { + $$ = label_add(@$, LblXml, uniq_label("xfile")); + xml_statements.push($$); + statement_begin(@$, DELETE); + std::vector<cbl_file_t*> + filenames($filenames->files.begin(), + $filenames->files.end() ); + parser_file_delete_file( $$, filenames); + } + ; +retry_phrase: %empty + | RETRY expr TIMES + | FOR expr SECONDS + | FOREVER { + cbl_unimplemented("DELETE FILE RETRY"); + } + ; + delete_impl: DELETE delete_body[file] { file_delete_args.call_parser_file_delete(true); @@ -8634,6 +8736,63 @@ delete_body: filename[file] record $$ = $file; } ; + +delete_error: %empty %prec DELETE { + $$.on_error = $$.not_error = nullptr; + } + | delete_excepts %prec DELETE + ; +delete_excepts: delete_except[a] statements %prec DELETE + { + assert( $a.on_error || $a.not_error ); + assert( ! ($a.on_error && $a.not_error) ); + $$ = $a; + } + | delete_excepts[a] delete_except[b] statements %prec DELETE + { + if( $a.on_error && $a.not_error ) { + error_msg(@1, "too many ON ERROR clauses"); + YYERROR; + } + // "ON" and "NOT ON" could be reversed, but not duplicated. + if( $a.on_error && $b.on_error ) { + error_msg(@1, "duplicate ON ERROR clauses"); + YYERROR; + } + if( $a.not_error && $b.not_error ) { + error_msg(@1, "duplicate NOT ON ERROR clauses"); + YYERROR; + } + $$ = $a; + if( $$.on_error ) { + assert($b.not_error); + $$.not_error = $b.not_error; + } else { + assert($b.on_error); + $$.on_error = $b.on_error; + } + } + ; +delete_except: EXCEPTION + { + auto xml_stmt = xml_statements.top(); + // The value of the pointer no longer matters, only NULL or not. + $$.on_error = $$.not_error = nullptr; + switch($1) { + case EXCEPTION: + $$.on_error = xml_stmt; + parser_file_delete_on_exception(xml_stmt); + break; + case NOT: + $$.not_error = xml_stmt; + parser_file_delete_not_exception(xml_stmt); + break; + default: + gcc_unreachable(); + } + } + ; + end_delete: %empty %prec DELETE | END_DELETE ; @@ -10536,7 +10695,9 @@ function_udf: FUNCTION_UDF '(' arg_list[args] ')' { cbl_ffi_arg_t actual(param.crv, ar); return actual; } ); - auto name = new_literal(strlen(L->name), L->name, quoted_e); + // Pretend hex-encoded because that means use verbatim. + auto attr = cbl_field_attr_t(quoted_e | hex_encoded_e); + auto name = new_literal(strlen(L->name), L->name, attr); ast_call( @1, name, $$, args.size(), args.data(), NULL, NULL, true ); } | FUNCTION_UDF_0 { @@ -10547,8 +10708,11 @@ function_udf: FUNCTION_UDF '(' arg_list[args] ')' { const auto returning = cbl_field_of(symbol_at(L->returning)); $$ = new_temporary_clone(returning); $$->data.initial = returning->name; // user's name for the field - - auto name = new_literal(strlen(L->name), L->name, quoted_e); + cbl_field_attr_t call_attr + = (cbl_field_attr_t)(quoted_e|hex_encoded_e); + cbl_field_t *name = new_literal(strlen(L->name), + L->name, + call_attr); ast_call( @1, name, $$, narg, args, NULL, NULL, true ); } ; @@ -11135,6 +11299,18 @@ subst_input: anycase first_last varg[v1] varg[v2] { } ; +locale_name: NAME + { + auto e = symbol_locale(PROGRAM, $NAME); + if( !e ) { + error_msg(@NAME, "no such SPECIAL-NAMES LOCALE: %qs", $NAME); + YYERROR; + } + $$ = const_cast<char*>( + __gg__encoding_iconv_name(cbl_locale_of(e)->encoding) ); + } + ; + intrinsic_locale: LOCALE_COMPARE '(' varg[r1] varg[r2] ')' { @@ -11143,11 +11319,12 @@ intrinsic_locale: cbl_refer_t dummy = {}; if( ! intrinsic_call_3($$, LOCALE_COMPARE, $r1, $r2, &dummy) ) YYERROR; } - | LOCALE_COMPARE '(' varg[r1] varg[r2] varg[r3] ')' + | LOCALE_COMPARE '(' varg[r1] varg[r2] locale_name ')' { location_set(@1); $$ = new_alphanumeric(); - if( ! intrinsic_call_3($$, LOCALE_COMPARE, $r1, $r2, $r3) ) YYERROR; + cbl_refer_t locale(new_literal($locale_name)); + if( ! intrinsic_call_3($$, LOCALE_COMPARE, $r1, $r2, &locale) ) YYERROR; } | LOCALE_DATE '(' varg[r1] ')' @@ -11453,6 +11630,10 @@ optional: %empty { $$ = false; } | OPTIONAL { $$ = true; } ; +override: %empty { $$ = false; } + | OVERRIDE { $$ = true; } + ; + program_kw: %empty | PROGRAM_kw ; @@ -11900,6 +12081,7 @@ void ast_call( const YYLTYPE& loc, cbl_refer_t name, const cbl_refer_t& returnin if( is_literal(name.field) ) { cbl_field_t called = { FldLiteralA, quoted_e | constant_e, name.field->data, 77 }; + called.attr |= name.field->attr; snprintf(called.name, sizeof(called.name), "_%s", name.field->data.initial); name.field = cbl_field_of(symbol_field_add(PROGRAM, &called)); symbol_field_location(field_index(name.field), loc); @@ -13030,13 +13212,13 @@ struct expand_group : public std::list<cbl_refer_t> { }; -static const char * initial_default_value; - const char * wsclear() { return initial_default_value; } +static const uint32_t * initial_default_value; + const uint32_t * wsclear() { return initial_default_value; } void -wsclear( char ch ) { - static char byte = ch; - initial_default_value = &byte; +wsclear( uint32_t i ) { + static uint32_t init_val = i; + initial_default_value = &init_val; current.program_needs_initial(); } @@ -13558,16 +13740,16 @@ literal_t::set( const cbl_field_t * field ) { literal_t& literal_t::set_prefix( const char *input, size_t len ) { - encoding = current_encoding('A'); + encoding = current_encoding(display_encoding_e); assert(len < sizeof(prefix)); std::fill(prefix, prefix + sizeof(prefix), '\0'); std::transform(input, input + len, prefix, toupper); switch(prefix[0]) { case '\0': case 'Z': - encoding = current_encoding('A'); + encoding = current_encoding(display_encoding_e); break; case 'N': - encoding = current_encoding('N'); + encoding = current_encoding(national_encoding_e); if( 'X' == prefix[1] ) { cbl_unimplemented("NX literals"); } @@ -13583,7 +13765,7 @@ literal_t::set_prefix( const char *input, size_t len ) { default: gcc_unreachable(); } - assert(encoding <= iconv_YU_e); + assert(valid_encoding(encoding)); return *this; } @@ -13608,8 +13790,8 @@ literal_attr( const char prefix[] ) { case 'X': switch(prefix[0]) { case 'B': return cbl_field_attr_t(hex_encoded_e | bool_encoded_e); - case 'N': - case 'U': cbl_unimplemented("National"); return none_e; + case 'N': cbl_unimplemented("Hexadecimal National"); return none_e; + case 'U': cbl_unimplemented("Hexadecimal Unicode"); return none_e; } break; } diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h index 1fbc8f5..99c9cef 100644 --- a/gcc/cobol/parse_ante.h +++ b/gcc/cobol/parse_ante.h @@ -273,38 +273,11 @@ static inline char * dequote( char input[] ) { static const char * name_of( cbl_field_t *field ) { assert(field); - // Because this can be called after .initial has been converted to the - // field->codeset.encoding, we have to undo that. There may be some danger - // associated with returning a static. I don't actually know. -- RJD. - static size_t static_length = 0; - static char * static_buffer = nullptr; - - if( field->data.initial == nullptr ) return field->name; - - if( field->name[0] == '_' ) - { - // Make a copy of .initial - if( static_length < field->data.capacity+1 ) - { - static_length = field->data.capacity+1; - static_buffer = static_cast<char *>(xrealloc(static_buffer, - static_length)); - memcpy(static_buffer, field->data.initial, field->data.capacity); - static_buffer[field->data.capacity] = '\0'; - } - // Convert it from ->encoding to DEFAULT_CHARMAP_SOURCE - size_t charsout; - char *converted = __gg__iconverter(field->codeset.encoding, - DEFAULT_CHARMAP_SOURCE, - field->data.initial, - field->data.capacity, - &charsout ); - memcpy(static_buffer, converted, charsout); - static_buffer[charsout] = '\0'; - } - + if( field->data.initial == nullptr ) { + return field->name; + } return field->name[0] == '_' && field->data.initial? - static_buffer : field->name; + field->data.original() : field->name; } static const char * @@ -1337,6 +1310,7 @@ std::map<std::string, std::list<std::string>> class prog_descr_t { std::set<std::string> call_targets, subprograms; + std::set<cbl_locale_t> locales; public: std::set<function_descr_t> function_repository; size_t program_index; @@ -1361,17 +1335,14 @@ public: } alpha, national; encoding_t() : national(EBCDIC_e) {} } alphabet; - struct locale_t { - cbl_name_t name; const char *os_name; - locale_t() : name(""), os_name(nullptr) {} - locale_t(const cbl_name_t name, const char *os_name) - : name(""), os_name(os_name) { - if( name ) { - bool ok = namcpy(YYLTYPE(), this->name, name); - gcc_assert(ok); - } - } - } locale; + + bool locale_add( const cbl_locale_t& locale ) { + auto e = symbol_locale_add(program_index, &locale); + assert(e); + auto p = locales.insert(locale); + return p.second; + } + cbl_options_t options; explicit prog_descr_t( size_t isymbol ) @@ -1904,7 +1875,14 @@ static class current_t { return program.alphabet.alpha.encoding; } cbl_encoding_t national_encoding() const { - if( programs.empty() ) return EBCDIC_e; + cbl_encoding_t when_empty = EBCDIC_e; + char *alternate = getenv("NATIONAL"); + if( alternate ) + { + when_empty = __gg__encoding_iconv_type(alternate); + gcc_assert(when_empty); + } + if( programs.empty() ) return when_empty; const prog_descr_t& program = programs.top(); return program.alphabet.national.encoding; } @@ -1929,23 +1907,8 @@ static class current_t { return programs.top().options.default_round = mode; } - const char * - locale() { - return programs.empty()? NULL : programs.top().locale.os_name; - } - const char * - locale( const cbl_name_t name ) { - if( programs.empty() ) return NULL; - const prog_descr_t::locale_t& locale = programs.top().locale; - return 0 == strcmp(name, locale.name)? locale.name : NULL; - } - const prog_descr_t::locale_t& - locale( const cbl_name_t name, const char os_name[] ) { - if( programs.empty() ) { - static prog_descr_t::locale_t empty; - return empty; - } - return programs.top().locale = prog_descr_t::locale_t(name, os_name); + bool locale_add( const cbl_locale_t& locale ) { + return programs.top().locale_add(locale); } bool new_program ( const YYLTYPE& loc, cbl_label_type_t type, @@ -2296,11 +2259,13 @@ add_debugging_declarative( const cbl_label_t * label ) { } } -cbl_options_t current_options() { +cbl_options_t +current_options() { return current.options_paragraph; } -cbl_encoding_t current_encoding( char a_or_n ) { +cbl_encoding_t +current_encoding( char a_or_n ) { cbl_encoding_t retval; switch(a_or_n) { case 'A': @@ -2316,14 +2281,17 @@ cbl_encoding_t current_encoding( char a_or_n ) { return retval; } -size_t current_program_index() { +size_t +current_program_index() { return current.program()? current.program_index() : 0; } -cbl_label_t * current_section() { +cbl_label_t * +current_section() { return current.section(); } -cbl_label_t * current_paragraph() { +cbl_label_t * +current_paragraph() { return current.paragraph(); } @@ -2402,8 +2370,13 @@ literal_refmod_valid( YYLTYPE loc, const cbl_refer_t& r ); static bool is_integer_literal( const cbl_field_t *field ) { if( field->type == FldLiteralN ) { - const char *initial = field->data.initial; - + size_t nchar; + const char *initial = __gg__iconverter(field->codeset.encoding, + DEFAULT_SOURCE_ENCODING, + field->data.initial, + strlen(field->data.initial), + &nchar); + assert(strlen(initial) == nchar); switch( *initial ) { case '-': case '+': ++initial; } @@ -2982,16 +2955,28 @@ blank_pad_initial( const char initial[], size_t capacity, size_t new_size ) { return p; } +/* + * When cbl_field_t::internalize is called, its data.initial value has been + * set, but nothing has been done to it. It is encoded according to the source + * code. internalize() converts data.initial to the field's encoding. + * + * If syntax used was was PIC VALUE, in that order, then PIC set the field's + * encoding, and the VALUE clause can verify that its encoding matches. If the + * order was VALUE PIC, the value leaves the encoding uninitialized unless the + * value string bore an encoding prefix. When PIC is processed, codeset_t::set + * allows it to set the encoding only if it's either uninitialized, or the PIC + * encoding matches the existing one set by VALUE. In no event does one + * override the other; they must agree. + * + * internalize() fails if data.initial cannot be converted to the field's + * encoding. + */ static void -value_encoding_check( const YYLTYPE& loc, cbl_field_t *field, cbl_encoding_t encoding ) { +value_encoding_check( const YYLTYPE& loc, cbl_field_t *field ) { if( ! field->internalize() ) { error_msg(loc, "inconsistent string literal encoding for '%s'", field->data.initial); } - if( encoding != field->codeset.encoding ) { - warn_msg(loc, "VALUE encoded as %qs for data item encoded as %qs", - __gg__encoding_iconv_name(encoding), field->codeset.name()); - } } #pragma GCC diagnostic push @@ -3046,12 +3031,16 @@ file_add( YYLTYPE loc, cbl_file_t *file ) { static cbl_alphabet_t * -alphabet_add( const YYLTYPE& loc, cbl_encoding_t encoding ) { - cbl_alphabet_t alphabet(loc, encoding); +alphabet_add( const cbl_alphabet_t& alphabet ) { symbol_elem_t *e = symbol_alphabet_add(PROGRAM, &alphabet); assert(e); return cbl_alphabet_of(e); } +static cbl_alphabet_t * +alphabet_add( const YYLTYPE& loc, cbl_encoding_t encoding ) { + cbl_alphabet_t alphabet(loc, encoding); + return alphabet_add(alphabet); +} // The current field always exists in the symbol table, even if it's incomplete. static cbl_field_t * @@ -3302,8 +3291,9 @@ data_division_ready() { static size_t nsymbol = 0; if( (nsymbol = symbols_update(nsymbol, nparse_error == 0)) > 0 ) { if( ! literally_one ) { - literally_one = new_literal("1"); - literally_zero = new_literal("0"); + // Use strdup so cbl_field_t::internalize can free them if need be. + literally_one = new_literal(xstrdup("1")); + literally_zero = new_literal(xstrdup("0")); } } diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l index 07aa76d..643d099 100644 --- a/gcc/cobol/scan.l +++ b/gcc/cobol/scan.l @@ -1801,8 +1801,8 @@ B-SHIFT-RC if( elem->type == SymField ) { auto f = cbl_field_of(elem); if( f->type == FldLiteralA && f->has_attr(constant_e) ) { - type = date_time_fmt(f->data.initial); - yylval.string = xstrdup(f->data.initial); + type = date_time_fmt(f->data.original()); + yylval.string = xstrdup(f->data.original()); } } else { yylval.string = xstrdup(yytext); diff --git a/gcc/cobol/show_parse.h b/gcc/cobol/show_parse.h index e1a8cb2..7945e90 100644 --- a/gcc/cobol/show_parse.h +++ b/gcc/cobol/show_parse.h @@ -140,7 +140,13 @@ extern bool cursor_at_sol; fprintf(stderr, "%s", (b).field->name); \ if( (b).field->type == FldLiteralA || (b).field->type == FldLiteralN ) \ { \ - fprintf(stderr, " \"%s\"", (b).field->data.initial); \ + size_t nbytes; \ + const char *literal = __gg__iconverter((b).field->codeset.encoding, \ + DEFAULT_SOURCE_ENCODING, \ + (b).field->data.initial, \ + strlen((b).field->data.initial), \ + &nbytes); \ + fprintf(stderr, " \"%s\"", literal); \ } \ else \ { \ diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc index 2a299ce..07dc0e6 100644 --- a/gcc/cobol/symbols.cc +++ b/gcc/cobol/symbols.cc @@ -293,7 +293,7 @@ elementize( const cbl_field_t& field ) { // Dubner did the following because he didn't feel like creating yet another // cbl_field_t constructor that included the hardcoded encoding for the // global special registers. - sym.elem.field.codeset.encoding = iconv_CP1252_e; + sym.elem.field.codeset.set(); return sym; } @@ -511,6 +511,9 @@ symbol_elem_cmp( const void *K, const void *E ) case SymSpecial: return special_pair_cmp(k->elem.special, e->elem.special)? 0 : 1; break; + case SymLocale: + return strcasecmp(k->elem.locale.name, e->elem.locale.name); + break; case SymAlphabet: return strcasecmp(k->elem.alphabet.name, e->elem.alphabet.name); break; @@ -677,6 +680,22 @@ symbol_special( size_t program, const char name[] ) } struct symbol_elem_t * +symbol_locale( size_t program, const char name[] ) +{ + cbl_locale_t locale(name); + assert(strlen(name) < sizeof locale.name); + strcpy(locale.name, name); + + struct symbol_elem_t key(SymLocale, program), *e; + key.elem.locale = locale; + + e = static_cast<struct symbol_elem_t *>(lfind( &key, symbols.elems, + &symbols.nelem, sizeof(key), + symbol_elem_cmp ) ); + return e; +} + +struct symbol_elem_t * symbol_alphabet( size_t program, const char name[] ) { cbl_alphabet_t alphabet(YYLTYPE(), custom_encoding_e); // cppcheck-suppress syntaxError @@ -1510,11 +1529,11 @@ field_str( const cbl_field_t *field ) { { // Apparently we need to trace back the meaning of data.literal for // field::type == FldNumericDisplay - enc_from = DEFAULT_CHARMAP_SOURCE; + enc_from = DEFAULT_SOURCE_ENCODING; } init = __gg__iconverter(enc_from, - DEFAULT_CHARMAP_SOURCE, + DEFAULT_SOURCE_ENCODING, false_data, field->data.capacity, &charsout); @@ -1522,12 +1541,12 @@ field_str( const cbl_field_t *field ) { auto eoinit = init + strlen(init); char *s = xasprintf("'%s'", init); - // No NUL within the initial data. + // No NUL within the initial data. auto ok = std::none_of( init, eoinit, []( char ch ) { return ch == '\0'; } ); assert(ok); - // If any of the init are unprintable, provide a hex version. + // If any of the init are unprintable, provide a hex version. if( ! std::all_of(init, eoinit, fisprint) ) { if( is_elementary(field->type) && field->type != FldPointer ) { const size_t len = strlen(s) + 8 + 2 * field->data.capacity; @@ -1663,7 +1682,7 @@ symbols_alphabet_set( size_t program, const char name[]) { //// // Define alphabets for codegen. //// const cbl_alphabet_t *alphabet = nullptr; //// bool supported = true; -//// +//// //// std::for_each( symbols_begin(program), symbols_end(), //// [&alphabet, &supported]( const auto& sym ) { //// if( sym.type == SymAlphabet ) { @@ -1679,7 +1698,7 @@ symbols_alphabet_set( size_t program, const char name[]) { //// cbl_unimplemented("alphabet %qs (as %qs)", alphabet->name, encoding); //// return false; //// } -//// +//// //// // Set collation sequence before parser_symbol_add.` //// if( name ) { //// symbol_elem_t *e = symbol_alphabet(program, name); @@ -1906,38 +1925,46 @@ symbols_update( size_t first, bool parsed_ok ) { } } - if( ! field->codeset.valid() ) { - switch(field->type) { - case FldForward: - case FldInvalid: - gcc_unreachable(); - case FldAlphaEdited: - case FldAlphanumeric: - case FldClass: - case FldDisplay: - case FldGroup: - case FldLiteralA: - case FldNumericDisplay: - case FldNumericEdited: + if( ! field->codeset.consistent() ) { + if( ! field->codeset.valid() ) { + switch(field->type) { + case FldForward: + case FldInvalid: + gcc_unreachable(); + case FldAlphaEdited: + case FldAlphanumeric: + case FldClass: + case FldDisplay: + case FldGroup: + case FldLiteralA: + case FldLiteralN: + case FldNumericDisplay: + case FldNumericEdited: + if( ! (field->has_attr(register_e) || field->has_attr(hex_encoded_e)) ) { + error_msg(symbol_field_location(field_index(field)), + "internal: %qs encoding not defined", field->name); + } + break; + case FldConditional: + case FldFloat: + case FldIndex: + case FldNumericBin5: + case FldNumericBinary: + case FldPacked: + case FldPointer: + case FldSwitch: + break; + } + } else { if( ! (field->has_attr(register_e) || field->has_attr(hex_encoded_e)) ) { error_msg(symbol_field_location(field_index(field)), - "internal: %qs encoding not defined", field->name); + "internal: %qs encoding %qs inconsistent", + field->name, + cbl_alphabet_t::encoding_str(field->codeset.encoding) ); } - break; - case FldConditional: - case FldFloat: - case FldIndex: - case FldLiteralN: - case FldNumericBin5: - case FldNumericBinary: - case FldPacked: - case FldPointer: - case FldSwitch: - break; } } - assert( ! field->is_typedef() ); if( parsed_ok ) parser_symbol_add(field); @@ -2542,6 +2569,13 @@ symbol_file_add( size_t program, cbl_file_t *file ) { } symbol_elem_t * +symbol_locale_add( size_t program, const cbl_locale_t *locale ) { + symbol_elem_t sym{ SymLocale, program }; + sym.elem.locale = *locale; + return symbol_add(&sym); +} + +symbol_elem_t * symbol_alphabet_add( size_t program, const cbl_alphabet_t *alphabet ) { symbol_elem_t sym{ SymAlphabet, program }; sym.elem.alphabet = *alphabet; @@ -3202,19 +3236,56 @@ constant_of( size_t isym ) return field; } +cbl_locale_t::cbl_locale_t( const cbl_name_t name, const char iconv_name[] ) { + gcc_assert(strlen(name) < sizeof this->name); + strcpy(this->name, name); + + if( iconv_name ) { + encoding = __gg__encoding_iconv_type(iconv_name); + + strcpy(collation, "C"); + // If the iconv_name is prefixed by langauge_COUNTRY (e.g. en_US), capture that. + auto pend = iconv_name + strlen(iconv_name); + auto p = std::find(iconv_name, pend, '.'); + if( p < pend ) { + auto pend2 = std::copy(iconv_name, p, collation); + std::fill(pend2, collation + sizeof(collation), '\0'); + iconv_name = ++p; + } + encoding = __gg__encoding_iconv_type(iconv_name); + } +} + +cbl_alphabet_t::cbl_alphabet_t(const YYLTYPE& loc, size_t locale, cbl_name_t name ) + : loc(loc) + , locale(locale) + , low_index(0) + , high_index(255) + , last_index(0) +{ + if( locale > 0 ) { + encoding = cbl_locale_of(symbol_at(locale))->encoding; + } + memset(collation_sequence, 0xFF, sizeof(collation_sequence)); + if( name ) { // from Special-Names collation_sequence + assert(strlen(name) < sizeof(cbl_name_t)); + strcpy(this->name, name); + } +} + /* * As parsed, the alphabet reflects the encoding of the source code. If the * program uses a different encoding for alphanumeric, convert the alphabet to - * that. - * + * that. + * * Because a custom alphabet is rare and occurs at most only once per program, * we don't attempt to avoid re-encoding. "Conversion" of ASCII to ASCII is at - * most 256 calls to iconv(3). + * most 256 calls to iconv(3). */ void cbl_alphabet_t::reencode() { - const unsigned char * const pend = alphabet + sizeof(alphabet); + const unsigned char * const pend = collation_sequence + sizeof(collation_sequence); std::vector<char> tgt(256, (char)0xFF); /* Keep copies of low_index and last_index for use in run-time as LOW-VALUE @@ -3230,13 +3301,14 @@ cbl_alphabet_t::reencode() { * a custom alphabet are from NIST, which of course are ASCII. */ const char *fromcode = __gg__encoding_iconv_name(CP1252_e); - const char *tocode = __gg__encoding_iconv_name(current_encoding('A')); + const char *tocode = + __gg__encoding_iconv_name(current_encoding(display_encoding_e)); iconv_t cd = iconv_open(tocode, fromcode); - + #if optimal_reencode if( fromcode == tocode ) { // semantically tgt.resize(0); - return tgt; // Return empty vector; caller copies zero bytes. + return tgt; // Return empty vector; caller copies zero bytes. } #endif @@ -3247,14 +3319,14 @@ cbl_alphabet_t::reencode() { * that letter in the alphanumeric encoding, and set its collation position * in that alphabet. */ - for( const unsigned char *p = alphabet; p < pend; p++ ) { + for( const unsigned char *p = collation_sequence; p < pend; p++ ) { if( *p == 0xFF ) continue; - unsigned char ch = p - alphabet; + unsigned char ch = p - collation_sequence; unsigned char pos[8] = {}; size_t inbytesleft = 1, outbytesleft = sizeof(pos); char *inbuf = reinterpret_cast<char*>(&ch), *outbuf = reinterpret_cast<char*>(pos); - + size_t n = iconv(cd, &inbuf, &inbytesleft, &outbuf, &outbytesleft); if( n == size_t(-1) ) { @@ -3273,7 +3345,7 @@ cbl_alphabet_t::reencode() { fromcode, ch, ch, n, tocode); continue; } - + if( ch == low_index ) { low_index = pos[0]; } @@ -3283,21 +3355,21 @@ cbl_alphabet_t::reencode() { if( ch == high_index ) { high_index = pos[0]; } - + tgt.at(pos[0]) = *p; } - - std::copy(tgt.begin(), tgt.end(), alphabet); + + std::copy(tgt.begin(), tgt.end(), collation_sequence); } bool cbl_alphabet_t::assign( const YYLTYPE& loc, unsigned char ch, unsigned char high_value ) { - if( alphabet[ch] == 0xFF || alphabet[ch] == high_value) { - alphabet[ch] = high_value; + if( collation_sequence[ch] == 0xFF || collation_sequence[ch] == high_value) { + collation_sequence[ch] = high_value; last_index = ch; return true; } - auto taken = alphabet[ch]; + auto taken = collation_sequence[ch]; error_msg(loc, "ALPHABET %s, character %<%c%> (X%'%x%') " "in position %d already defined at position %d", name, @@ -3310,7 +3382,7 @@ cbl_alphabet_t::assign( const YYLTYPE& loc, unsigned char ch, unsigned char high void cbl_alphabet_t::also( const YYLTYPE& loc, size_t ch ) { if( ch < 256 ) { - alphabet[ch] = alphabet[last_index]; + collation_sequence[ch] = collation_sequence[last_index]; if( ch == high_index ) high_index--; return; } // else it's a figurative constant ... @@ -3323,20 +3395,20 @@ cbl_alphabet_t::also( const YYLTYPE& loc, size_t ch ) { // last_index is already set; use it as the "last value before ALSO" if( attr & low_value_e ) { - alphabet[0] = alphabet[last_index]; + collation_sequence[0] = collation_sequence[last_index]; return; } if( attr & high_value_e ) { - alphabet[high_index--] = alphabet[last_index]; + collation_sequence[high_index--] = collation_sequence[last_index]; return; } if( attr & (space_value_e|quote_value_e) ) { ch = field->data.initial[0]; - alphabet[ch] = alphabet[last_index]; + collation_sequence[ch] = collation_sequence[last_index]; return; } if( attr & (zero_value_e) ) { - alphabet[0] = alphabet[last_index]; + collation_sequence[0] = collation_sequence[last_index]; error_msg(loc, "ALSO value '%s' is unknown", field->name); return; } @@ -3448,18 +3520,33 @@ new_literal_add( const char initial[], uint32_t len, } else { - static char empty[2] = "\0"; field = new_temporary_impl(FldLiteralA); field->attr |= attr; - field->data.initial = len > 0? initial : empty; + + if(len == 0) + { + // This will cover UTF-32, should that arise. + size_t nbytes = 4; + char *init = static_cast<char *>(xmalloc(nbytes)); + memset(init, 0, nbytes); + field->data.initial = init; + } + if(len) + { + char *init = static_cast<char *>(xmalloc(len+4)); + memcpy(init, initial, len); + memset(init+len, 0, 4); + field->data.initial = init; + } field->data.capacity = len; } if( ! field->has_attr(hex_encoded_e) ) { - field->codeset.set(encoding); - if( ! field->internalize() ) { - ERROR_FIELD(field, "inconsistent string literal encoding for '%s'", initial); + // If the literal bore a prefix, set the encoding, + if( encoding != cbl_field_t::codeset_t::source_encoding->type ) { + field->codeset.set(encoding); } + field->internalize(); } static size_t literal_count = 1; @@ -3595,6 +3682,14 @@ new_alphanumeric( size_t capacity, const cbl_name_t name = nullptr ) { extern os_locale_t os_locale; +const encodings_t cbl_field_t::codeset_t::source_encodings[2] = { + { false, iconv_UTF_8_e, "UTF-8" }, + { true, iconv_CP1252_e, "CP1252" }, +}; +const encodings_t * cbl_field_t::codeset_t::source_encoding = { + cbl_field_t::codeset_t::source_encodings +}; + const encodings_t cbl_field_t::codeset_t::standard_internal = { true, iconv_CP1252_e, "CP1252" }; @@ -3603,7 +3698,7 @@ const encodings_t cbl_field_t::codeset_t::standard_internal = { cbl_field_t * new_temporary( enum cbl_field_type_t type, const char *initial, bool is_signed ) { const bool force_unsigned = type == FldNumericBin5 && ! is_signed; - + if( ! initial && ! force_unsigned ) { assert( ! is_literal(type) ); // Literal type must have literal value. return temporaries.acquire(type, initial); @@ -3719,29 +3814,26 @@ cbl_field_t::is_ascii() const { * never reverts. */ -static const char * -guess_encoding() { - static const char *fromcode; - - if( ! fromcode ) { - return fromcode = os_locale.assumed; - } - - if( fromcode == os_locale.assumed ) { - fromcode = os_locale.codeset; - if( 0 != strcmp(fromcode, "C") ) { // anything but that - return fromcode; - } - } - - return standard_internal.name; -} - const char * cbl_field_t::internalize() { - static const char *fromcode = guess_encoding(); + /* The purpose of this routine is to return a nul-terminated string which + is data.initial converted from the source-code characters to the + codeset.encoding characters. + + The contract between this routine and the routines that call it is that + for alphanumeric types, data.initial shall have the same number of + characters as will be needed to fill data.capacity. + + Be aware that for PIC X(32) Z"foo", there are the characters "foo", + followed by a NUL, and then 28 spaces to fill it out. It turns out that + iconv, given a character count of 32, converts all 32, including the + embedded NUL. So, that case works even through strlen(initial) is + smaller than the length of initial, which is the same as capacity. + */ + + static const char *fromcode = codeset.source_encodings[0].name; static const size_t noconv = size_t(-1); - static std::map<std::string, iconv_t> tocodes; + static std::unordered_map<std::string, iconv_t> tocodes; if( ! codeset.valid() ) { dbgmsg("%s:%d: not converting %s", __func__, __LINE__, data.initial); @@ -3769,20 +3861,33 @@ cbl_field_t::internalize() { assert(0 == strlen(data.initial)); return data.initial; } - if( holds_ascii() && is_ascii() ) return data.initial; + if( holds_ascii() && is_ascii() ) { + if( type != FldNumericEdited ) { + if( ! data.initial_within_capacity() ) { + ERROR_FIELD(this, "%s %s VALUE %qs of %zu exceeds size %u", + cbl_field_t::level_str(level), name, data.initial, + strlen(data.initial), data.capacity ); + } + } + return data.initial; + } assert(data.capacity > 0); // The final 2 bytes of the output are "!\0". It's a debugging sentinel. size_t n; size_t inbytesleft = data.capacity; size_t outbytesleft = inbytesleft; - char *in = const_cast<char*>(data.initial); - char *out = static_cast<char*>( xcalloc(1, outbytesleft + 2) ), *output = out; if( !is_literal(this) && inbytesleft < strlen(data.initial) ) { inbytesleft = strlen(data.initial); } + if( type == FldNumericEdited ) { + outbytesleft = inbytesleft; + } const unsigned int in_len = inbytesleft; + char *in = const_cast<char*>(data.initial); + char *out = static_cast<char*>( xcalloc(1, outbytesleft + 2) ), *output = out; + assert(fromcode != tocode); /* @@ -3799,8 +3904,9 @@ cbl_field_t::internalize() { do { if( (n = iconv( cd, &in, &inbytesleft, &out, &outbytesleft)) == noconv ) { - if( fromcode == os_locale.assumed ) { - fromcode = standard_internal.name; + if( fromcode == codeset.source_encodings[0].name ) { + codeset.source_encoding = &codeset.source_encodings[1]; + fromcode = codeset.source_encoding->name; tocodes.clear(); cd = tocodes[toname] = iconv_open(tocode, fromcode); dbgmsg("%s: trying input encoding %s", __func__, fromcode); @@ -3813,7 +3919,7 @@ cbl_field_t::internalize() { if( n == noconv ) { size_t i = in_len - inbytesleft; - yywarn("failed to encode %s %qs as %s (%zu of %u bytes left)", + yyerror("failed to encode %s %qs as %s (%zu of %u bytes left)", fromcode, data.initial + i, tocode, inbytesleft, in_len); if( false ) return NULL; return data.initial; @@ -3821,7 +3927,7 @@ cbl_field_t::internalize() { if( 0 < inbytesleft ) { // data.capacity + inbytesleft is not correct if the remaining portion has - // multibyte characters. But the fact reamins that the VALUE is too big. + // multibyte characters. But the fact remains that the VALUE is too big. ERROR_FIELD(this, "%s %s VALUE '%s' requires %zu bytes for size %u", cbl_field_t::level_str(level), name, data.initial, data.capacity + inbytesleft, data.capacity ); @@ -3829,7 +3935,7 @@ cbl_field_t::internalize() { // Replace data.initial only if iconv output differs. if( 0 != memcmp(data.initial, output, out - output) ) { - assert(out <= output + data.capacity); + assert(out <= output + data.capacity || type == FldNumericEdited); dbgmsg("%s: converted '%.*s' to %s", __func__, data.capacity, data.initial, tocode); struct localspace_t { @@ -3858,14 +3964,16 @@ cbl_field_t::internalize() { data.capacity = out - output; // trailing '!' will be overwritten } // Pad with trailing blanks, tacking a '!' on the end. - for( const char *eout = output + data.capacity; + for( const char *eout = output + data.capacity; out < eout; out += spc.len ) { memcpy(out, spc.space, spc.len); } - out[0] = '!'; + // Numeric literal strings may have leading zeros, making their length + // longer than their capacity. + out[0] = type == FldLiteralN? '\0' : '!'; assert(out[1] == '\0'); - free(const_cast<char*>(data.initial)); + data.orig = data.initial; data.initial = output; } else { free(output); diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h index 66fb2fd..6d29d06 100644 --- a/gcc/cobol/symbols.h +++ b/gcc/cobol/symbols.h @@ -224,6 +224,7 @@ enum symbol_type_t { SymAlphabet, SymFile, SymDataSection, + SymLocale, }; // The ISO specification says alphanumeric literals have a maximum length of @@ -237,7 +238,7 @@ struct cbl_field_data_t { uint32_t capacity, // allocated space digits; // magnitude: total digits (or characters) int32_t rdigits; // digits to the right - const char *initial, *picture; + const char *orig, *initial, *picture; enum etc_type_t { val88_e, upsi_e, value_e } etc_type; const char * @@ -268,6 +269,7 @@ struct cbl_field_data_t { , capacity(0) , digits(0) , rdigits(0) + , orig(0) , initial(0) , picture(0) , etc_type(value_e) @@ -279,6 +281,7 @@ struct cbl_field_data_t { , capacity(capacity) , digits(0) , rdigits(0) + , orig(0) , initial(0) , picture(0) , etc_type(value_e) @@ -293,6 +296,7 @@ struct cbl_field_data_t { , capacity(capacity) , digits(digits) , rdigits(rdigits) + , orig(0) , initial(initial) , picture(picture) , etc_type(value_e) @@ -387,6 +391,12 @@ struct cbl_field_data_t { return valify(); } + bool initial_within_capacity() const { + return initial[capacity] == '\0' + || initial[capacity] == '!'; + } + const char *original() const { return orig? orig : initial; } + protected: cbl_field_data_t& copy_self( const cbl_field_data_t& that ) { memsize = that.memsize; @@ -531,7 +541,7 @@ struct cbl_field_t { uint32_t level; cbl_occurs_t occurs; struct codeset_t { - static const encodings_t standard_internal; + static const encodings_t standard_internal, source_encodings[2], *source_encoding; cbl_encoding_t encoding; size_t alphabet; // unlikely explicit codeset_t(cbl_encoding_t encoding = custom_encoding_e, @@ -544,22 +554,26 @@ struct cbl_field_t { || (alphabet != 0 && encoding == custom_encoding_e); } + bool consistent() const { + return valid() && ( encoding == current_encoding('A') + || + encoding == current_encoding('N') + || + encoding == UTF8_e ); + } bool set( cbl_encoding_t encoding, size_t alphabet = 0 ) { - assert(encoding <= iconv_YU_e); + assert(valid_encoding(encoding)); if( ! valid() ) { // setting first time this->encoding = encoding; this->alphabet = alphabet; return valid(); } - // DUBNER override. Encoding has to change when - // 01 FOO VALUE ZERO. Just 0 is okay; ZERO is not. - this->encoding = encoding; return this->encoding == encoding && this->alphabet == alphabet; } bool set( const char picture_fragment[] = nullptr) { if( ! picture_fragment ) { - cbl_encoding_t currenc = current_encoding('A'); - bool retval = set(currenc); + cbl_encoding_t enc = current_encoding('A'); + bool retval = set(enc); return retval; } size_t len = strlen(picture_fragment); @@ -568,14 +582,15 @@ struct cbl_field_t { frag.begin(), ftoupper); switch(frag[0]) { case 'A': case 'X': case '9': - return set(current_encoding('A')); + return set(current_encoding(display_encoding_e)); case 'N': case 'U': if( std::all_of(frag.begin(), frag.end(), [first = frag[0]]( char ch ) { return first == ch; } ) ) { // All N's indicates National; all U's indicates UTF-8. - auto enc = frag[0] == 'N'? current_encoding('N') : UTF8_e; + auto enc = frag[0] == 'N' ? current_encoding(national_encoding_e) + : UTF8_e; return set(enc); } return false; // They all must be the same. @@ -739,7 +754,7 @@ struct cbl_field_t { uint32_t size() const; // table capacity or capacity const char * pretty_name() const { - if( name[0] == '_' && data.initial ) return data.initial; + if( name[0] == '_' && data.original() ) return data.original(); return name; } static const char * level_str(uint32_t level ); @@ -1185,6 +1200,13 @@ struct cbl_arith_error_t { cbl_label_addresses_t bottom; }; +struct cbl_delete_file_t { + cbl_label_addresses_t over; + cbl_label_addresses_t exception; + cbl_label_addresses_t no_exception; + cbl_label_addresses_t bottom; +}; + struct cbl_compute_error_t { // This is an int. The value is a cbl_compute_error_code_t tree compute_error_code; @@ -1232,7 +1254,10 @@ struct cbl_label_t { // for parse_xml processing: struct cbl_xml_parse_t *xml_parse; - + + // For parser_file_delete_file + struct cbl_delete_file_t *delete_file; + } structs; bool is_function() const { return type == LblFunction; } @@ -1525,6 +1550,19 @@ struct cbl_section_t { } }; +struct cbl_locale_t { + cbl_name_t name; + cbl_encoding_t encoding; + cbl_name_t collation; + + explicit cbl_locale_t(const cbl_name_t name, + const char iconv_name[] = nullptr ); + + bool operator<( const cbl_locale_t& that ) const { + return strcmp(name, that.name) < 0; + } +}; + struct cbl_special_name_t { int token; enum special_name_t id; @@ -1536,22 +1574,35 @@ struct cbl_special_name_t { char * hex_decode( const char text[] ); /* - * For a custom alphabet of single-byte encoding, cbl_alphabet_t::alphabet + * An alphabet may just name an encoding, which implies binary collation. + * + * An alphabet may reference a Special-Names LOCALE, which defines an encoding + * and a collation (perhaps by default). + * + * During Special-Names parsing, an Alphabet may reference an as-yet undefined + * LOCALE with an as-yet unknown encoding. As a placeholder it inserts a named, + * undefined cbl_locale_t symbol, which the Alphabet references. If that + * locale is never defined, the encoding remains unknown, resulting in an error + * diagnostic at the end of Special-Names. + * + * For a custom alphabet of single-byte encoding, cbl_alphabet_t::collation_sequence * holds the collation position of each encoded value. - * If 'A' sorts first (after LOW-VALUE), then alphabet['A'] == 1. - * If the encoding is ASCII, then 'A' is 65 and alphabet[ 65] == 1. - * If the encoding is EBCDIC CP1140, then 'A' is 193 and alphabet[193] == 1. + * If 'A' sorts first (after LOW-VALUE), then collation_sequence['A'] == 1. + * If the encoding is ASCII, then 'A' is 65 and collation_sequence[ 65] == 1. + * If the encoding is EBCDIC CP1140, then 'A' is 193 and collation_sequence[193] == 1. */ struct cbl_alphabet_t { YYLTYPE loc; cbl_name_t name; cbl_encoding_t encoding; - unsigned char low_index, high_index, last_index, alphabet[256]; + size_t locale; // index to cbl_locale_t symbol + unsigned char low_index, high_index, last_index, collation_sequence[256]; unsigned char low_char, high_char; cbl_alphabet_t() : loc { 1,1, 1,1 } , encoding(ASCII_e) + , locale(0) , low_index(0) , high_index(255) , last_index(0) @@ -1559,12 +1610,13 @@ struct cbl_alphabet_t { , high_char(0) { memset(name, '\0', sizeof(name)); - memset(alphabet, 0xFF, sizeof(alphabet)); + memset(collation_sequence, 0xFF, sizeof(collation_sequence)); } cbl_alphabet_t(const YYLTYPE& loc, cbl_encoding_t enc) : loc(loc) , encoding(enc) + , locale(0) , low_index(0) , high_index(255) , last_index(0) @@ -1572,14 +1624,17 @@ struct cbl_alphabet_t { , high_char(0) { memset(name, '\0', sizeof(name)); - memset(alphabet, 0xFF, sizeof(alphabet)); + memset(collation_sequence, 0xFF, sizeof(collation_sequence)); } + cbl_alphabet_t(const YYLTYPE& loc, size_t locale, cbl_name_t name ); + cbl_alphabet_t( const YYLTYPE& loc, const cbl_name_t name, unsigned char low_index, unsigned char high_index, - unsigned char alphabet[] ) + unsigned char collation_sequence[] ) : loc(loc) , encoding(custom_encoding_e) + , locale(0) , low_index(low_index), high_index(high_index) , last_index(high_index) , low_char(low_index) @@ -1587,21 +1642,23 @@ struct cbl_alphabet_t { { assert(strlen(name) < sizeof(this->name)); strcpy(this->name, name); - std::copy(alphabet, alphabet + sizeof(this->alphabet), this->alphabet); + std::copy(collation_sequence, + collation_sequence + sizeof(this->collation_sequence), + this->collation_sequence); } unsigned char low_value() const { - return alphabet[low_index]; + return collation_sequence[low_index]; } unsigned char high_value() const { - return alphabet[high_index]; + return collation_sequence[high_index]; } void add_sequence( const YYLTYPE& loc, const unsigned char seq[] ) { if( low_index == 0 ) low_index = seq[0]; - unsigned char last = last_index > 0? alphabet[last_index] + 1 : 0; + unsigned char last = last_index > 0? collation_sequence[last_index] + 1 : 0; for( const unsigned char *p = seq; !end_of_string(p); p++ ) { assign(loc, *p, last++); @@ -1612,7 +1669,7 @@ struct cbl_alphabet_t { add_interval( const YYLTYPE& loc, unsigned char low, unsigned char high ) { if( low_index == 0 ) low_index = low; - unsigned char last = alphabet[last_index]; + unsigned char last = collation_sequence[last_index]; for( unsigned char ch = low; ch < high; ch++ ) { assign(loc, ch, last++); @@ -1649,8 +1706,11 @@ struct cbl_alphabet_t { " 0 1 2 3 4 5 6 7" " 8 9 A B C C E F"); unsigned int row = 0; - for( auto p = alphabet; p < alphabet + sizeof(alphabet); p++ ) { - if( (p - alphabet) % 16 == 0 ) fprintf(stderr, "\n%4X\t", row++); + for( auto p = collation_sequence; + p < collation_sequence + sizeof(collation_sequence); p++ ) { + if( (p - collation_sequence) % 16 == 0 ) { + fprintf(stderr, "\n%4X\t", row++); + } fprintf(stderr, "%3u ", *p); } fprintf(stderr, "\n"); @@ -1870,6 +1930,7 @@ struct symbol_elem_t { cbl_field_t field; cbl_label_t label; cbl_special_name_t special; + cbl_locale_t locale; cbl_alphabet_t alphabet; cbl_file_t file; cbl_section_t section; @@ -1927,6 +1988,9 @@ struct symbol_elem_t { case SymSpecial: elem.special = that.elem.special; break; + case SymLocale: + elem.locale = that.elem.locale; + break; case SymAlphabet: elem.alphabet = that.elem.alphabet; break; @@ -2092,6 +2156,18 @@ cbl_special_name_of( symbol_elem_t *e ) { return &e->elem.special; } +static inline cbl_locale_t * +cbl_locale_of( symbol_elem_t *e ) { + assert(e && e->type == SymLocale); + return &e->elem.locale; +} + +static inline const cbl_locale_t * +cbl_locale_of( const symbol_elem_t *e ) { + assert(e && e->type == SymLocale); + return &e->elem.locale; +} + static inline cbl_alphabet_t * cbl_alphabet_of( symbol_elem_t *e ) { assert(e && e->type == SymAlphabet); @@ -2104,6 +2180,7 @@ cbl_alphabet_of( const symbol_elem_t *e ) { return &e->elem.alphabet; } + static inline cbl_file_t * cbl_file_of( symbol_elem_t *e ) { assert(e && e->type == SymFile); @@ -2477,6 +2554,7 @@ struct symbol_elem_t * symbol_literalA( size_t program, const char name[] ); struct cbl_special_name_t * symbol_special( special_name_t id ); struct symbol_elem_t * symbol_special( size_t program, const char name[] ); +struct symbol_elem_t * symbol_locale( size_t program, const char name[] ); struct symbol_elem_t * symbol_alphabet( size_t program, const char name[] ); struct symbol_elem_t * symbol_file( size_t program, const char name[] ); @@ -2524,6 +2602,7 @@ cbl_label_t * symbol_label_add( size_t program, cbl_label_t * symbol_program_add( size_t program, cbl_label_t *input ); symbol_elem_t * symbol_special_add( size_t program, cbl_special_name_t *special ); +symbol_elem_t * symbol_locale_add( size_t program, const cbl_locale_t *locale ); symbol_elem_t * symbol_alphabet_add( size_t program, const cbl_alphabet_t *alphabet ); symbol_elem_t * symbol_file_add( size_t program, @@ -2548,8 +2627,8 @@ static inline size_t upsi_register() { return symbol_index(symbol_field(0,0,"UPSI-0")); } -void wsclear( char ch); -const char *wsclear(); +void wsclear( uint32_t ch); +const uint32_t *wsclear(); enum cbl_call_convention_t { cbl_call_verbatim_e = 'V', diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc index 9615987..0e6ec8c 100644 --- a/gcc/cobol/util.cc +++ b/gcc/cobol/util.cc @@ -271,6 +271,8 @@ symbol_type_str( enum symbol_type_t type ) return "SymLabel"; case SymSpecial: return "SymSpecial"; + case SymLocale: + return "SymLocale"; case SymAlphabet: return "SymAlphabet"; case SymFile: @@ -1094,28 +1096,18 @@ cbl_field_t::report_invalid_initial_value(const YYLTYPE& loc) const { if( has_attr(all_alpha_e) ) { bool alpha_value = fig != zero_value_e; - // In order to check for all alphabetic characters, we have to convert - // data.initial back to ASCII: - - size_t outchars; - char *initial = __gg__iconverter(codeset.encoding, - DEFAULT_CHARMAP_SOURCE, - data.initial, - data.capacity, - &outchars); - if( fig == normal_value_e ) { - alpha_value = std::all_of( initial, - initial + - data.capacity, - []( char ch ) { - return ISSPACE(ch) || - ISPUNCT(ch) || - ISALPHA(ch); } ); + alpha_value = std::none_of( data.initial, + data.initial + + data.capacity, + []( char ch ) { + return + ISPUNCT(ch) || + ISDIGIT(ch); } ); } if( ! alpha_value ) { error_msg(loc, "alpha-only %s VALUE '%s' contains non-alphabetic data", - name, fig == zero_value_e? cbl_figconst_str(fig) : initial); + name, fig == zero_value_e? cbl_figconst_str(fig) : data.initial); } } @@ -1315,7 +1307,7 @@ valid_move( const struct cbl_field_t *tgt, const struct cbl_field_t *src ) size_t outcount; char *in_ascii = static_cast<char *>(xmalloc(4 * src->data.capacity)); const char *in_asciip = __gg__iconverter( src->codeset.encoding, - DEFAULT_CHARMAP_SOURCE, + DEFAULT_SOURCE_ENCODING, src->data.initial, src->data.capacity, &outcount ); @@ -2078,7 +2070,8 @@ cobol_lineno() { const char * cobol_filename() { - return input_filenames.empty()? input_filename_vestige : input_filenames.top().name; + return input_filenames.empty()? + input_filename_vestige : input_filenames.top().name; } void diff --git a/gcc/config.gcc b/gcc/config.gcc index c678b80..b0fa43b 100644 --- a/gcc/config.gcc +++ b/gcc/config.gcc @@ -5118,7 +5118,7 @@ case "${target}" in ;; loongarch*-*) - supported_defaults="abi arch tune fpu simd multilib-default strict-align-lib tls" + supported_defaults="abi arch tune fpu simd multilib-default strict-align-lib tls cmodel" # Local variables unset \ @@ -5539,6 +5539,22 @@ case "${target}" in # Remove the excessive appending comma. loongarch_multilib_list_c=${loongarch_multilib_list_c%,} loongarch_multilib_list_make=${loongarch_multilib_list_make%,} + + # Handle --with-cmodel. + # Make sure --with-cmodel is valid. If it was not specified, + # use medium as the default value. + case "${with_cmodel}" in + "" | medium) + tm_defines="${tm_defines} TARGET_DEFAULT_CMODEL=CMODEL_MEDIUM" + ;; + normal) + tm_defines="${tm_defines} TARGET_DEFAULT_CMODEL=CMODEL_NORMAL" + ;; + *) + echo "invalid option for --with-cmodel: '${with_cmodel}', available values are 'medium' and 'normal'" 1>&2 + exit 1 + ;; + esac ;; nds32*-*-*) diff --git a/gcc/config/arc/arc.cc b/gcc/config/arc/arc.cc index bb5db97..5c34d9c 100644 --- a/gcc/config/arc/arc.cc +++ b/gcc/config/arc/arc.cc @@ -6705,7 +6705,7 @@ arc_cannot_force_const_mem (machine_mode mode, rtx x) enum arc_builtin_id { -#define DEF_BUILTIN(NAME, N_ARGS, TYPE, ICODE, MASK) \ +#define DEF_BUILTIN(NAME, N_ARGS, TYPE, ICODE, MASK, ATTRS) \ ARC_BUILTIN_ ## NAME, #include "builtins.def" #undef DEF_BUILTIN @@ -6723,7 +6723,7 @@ struct GTY(()) arc_builtin_description static GTY(()) struct arc_builtin_description arc_bdesc[ARC_BUILTIN_COUNT] = { -#define DEF_BUILTIN(NAME, N_ARGS, TYPE, ICODE, MASK) \ +#define DEF_BUILTIN(NAME, N_ARGS, TYPE, ICODE, MASK, ATTRS) \ { (enum insn_code) CODE_FOR_ ## ICODE, N_ARGS, NULL_TREE }, #include "builtins.def" #undef DEF_BUILTIN @@ -6855,8 +6855,11 @@ arc_init_builtins (void) = build_function_type_list (long_long_integer_type_node, V2SI_type_node, V2HI_type_node, NULL_TREE); + /* Create const attribute for mathematical functions. */ + tree attr_const = tree_cons (get_identifier ("const"), NULL, NULL); + /* Add the builtins. */ -#define DEF_BUILTIN(NAME, N_ARGS, TYPE, ICODE, MASK) \ +#define DEF_BUILTIN(NAME, N_ARGS, TYPE, ICODE, MASK, ATTRS) \ { \ int id = ARC_BUILTIN_ ## NAME; \ const char *Name = "__builtin_arc_" #NAME; \ @@ -6866,7 +6869,7 @@ arc_init_builtins (void) if (MASK) \ arc_bdesc[id].fndecl \ = add_builtin_function (arc_tolower(name, Name), TYPE, id, \ - BUILT_IN_MD, NULL, NULL_TREE); \ + BUILT_IN_MD, NULL, ATTRS); \ } #include "builtins.def" #undef DEF_BUILTIN diff --git a/gcc/config/arc/builtins.def b/gcc/config/arc/builtins.def index e3c5780..ae230dc 100644 --- a/gcc/config/arc/builtins.def +++ b/gcc/config/arc/builtins.def @@ -20,7 +20,7 @@ builtins defined in the ARC part of the GNU compiler. Before including this file, define a macro - DEF_BUILTIN(NAME, N_ARGS, TYPE, ICODE, MASK) + DEF_BUILTIN(NAME, N_ARGS, TYPE, ICODE, MASK, ATTRS) NAME: `__builtin_arc_name' will be the user-level name of the builtin. `ARC_BUILTIN_NAME' will be the internal builtin's id. @@ -29,194 +29,196 @@ TYPE: A tree node describing the prototype of the built-in. ICODE: Name of attached insn or expander. If special treatment in arc.cc is needed to expand the built-in, use `nothing'. - MASK: CPU selector mask. */ + MASK: CPU selector mask. + ATTRS: Function attributes like "attr_const" for the `const' attribute + or "NULL_TREE" for no attribute. */ /* Special builtins. */ -DEF_BUILTIN (NOP, 0, void_ftype_void, nothing, 1) -DEF_BUILTIN (RTIE, 0, void_ftype_void, rtie, !TARGET_ARC600_FAMILY) -DEF_BUILTIN (SYNC, 0, void_ftype_void, sync, 1) -DEF_BUILTIN (BRK, 0, void_ftype_void, brk, 1) -DEF_BUILTIN (SWI, 0, void_ftype_void, swi, 1) -DEF_BUILTIN (UNIMP_S, 0, void_ftype_void, unimp_s, !TARGET_ARC600_FAMILY) -DEF_BUILTIN (TRAP_S, 1, void_ftype_usint, trap_s, !TARGET_ARC600_FAMILY) -DEF_BUILTIN (ALIGNED, 2, int_ftype_pcvoid_int, nothing, 1) -DEF_BUILTIN (CLRI, 0, int_ftype_void, clri, TARGET_V2) -DEF_BUILTIN (SLEEP, 1, void_ftype_usint, sleep, 1) - -DEF_BUILTIN (FLAG, 1, void_ftype_usint, flag, 1) -DEF_BUILTIN (SR, 2, void_ftype_usint_usint, sr, 1) -DEF_BUILTIN (KFLAG, 1, void_ftype_usint, kflag, TARGET_V2) -DEF_BUILTIN (CORE_WRITE, 2, void_ftype_usint_usint, core_write, 1) -DEF_BUILTIN (SETI, 1, void_ftype_int, seti, TARGET_V2) +DEF_BUILTIN (NOP, 0, void_ftype_void, nothing, 1, NULL_TREE) +DEF_BUILTIN (RTIE, 0, void_ftype_void, rtie, !TARGET_ARC600_FAMILY, NULL_TREE) +DEF_BUILTIN (SYNC, 0, void_ftype_void, sync, 1, NULL_TREE) +DEF_BUILTIN (BRK, 0, void_ftype_void, brk, 1, NULL_TREE) +DEF_BUILTIN (SWI, 0, void_ftype_void, swi, 1, NULL_TREE) +DEF_BUILTIN (UNIMP_S, 0, void_ftype_void, unimp_s, !TARGET_ARC600_FAMILY, NULL_TREE) +DEF_BUILTIN (TRAP_S, 1, void_ftype_usint, trap_s, !TARGET_ARC600_FAMILY, NULL_TREE) +DEF_BUILTIN (ALIGNED, 2, int_ftype_pcvoid_int, nothing, 1, NULL_TREE) +DEF_BUILTIN (CLRI, 0, int_ftype_void, clri, TARGET_V2, NULL_TREE) +DEF_BUILTIN (SLEEP, 1, void_ftype_usint, sleep, 1, NULL_TREE) + +DEF_BUILTIN (FLAG, 1, void_ftype_usint, flag, 1, NULL_TREE) +DEF_BUILTIN (SR, 2, void_ftype_usint_usint, sr, 1, NULL_TREE) +DEF_BUILTIN (KFLAG, 1, void_ftype_usint, kflag, TARGET_V2, NULL_TREE) +DEF_BUILTIN (CORE_WRITE, 2, void_ftype_usint_usint, core_write, 1, NULL_TREE) +DEF_BUILTIN (SETI, 1, void_ftype_int, seti, TARGET_V2, NULL_TREE) /* Regular builtins. */ -DEF_BUILTIN (NORM, 1, int_ftype_int, clrsbsi2, TARGET_NORM) -DEF_BUILTIN (NORMW, 1, int_ftype_short, normw, TARGET_NORM) -DEF_BUILTIN (SWAP, 1, int_ftype_int, rotlsi2_cnt16, TARGET_SWAP) -DEF_BUILTIN (DIVAW, 2, int_ftype_int_int, divaw, TARGET_EA_SET) -DEF_BUILTIN (CORE_READ, 1, usint_ftype_usint, core_read, 1) -DEF_BUILTIN (LR, 1, usint_ftype_usint, lr, 1) -DEF_BUILTIN (FFS, 1, int_ftype_int, ffs, (TARGET_EM && TARGET_NORM) || TARGET_HS) -DEF_BUILTIN (FLS, 1, int_ftype_int, fls, (TARGET_EM && TARGET_NORM) || TARGET_HS) +DEF_BUILTIN (NORM, 1, int_ftype_int, clrsbsi2, TARGET_NORM, attr_const) +DEF_BUILTIN (NORMW, 1, int_ftype_short, normw, TARGET_NORM, attr_const) +DEF_BUILTIN (SWAP, 1, int_ftype_int, rotlsi2_cnt16, TARGET_SWAP, attr_const) +DEF_BUILTIN (DIVAW, 2, int_ftype_int_int, divaw, TARGET_EA_SET, NULL_TREE) +DEF_BUILTIN (CORE_READ, 1, usint_ftype_usint, core_read, 1, NULL_TREE) +DEF_BUILTIN (LR, 1, usint_ftype_usint, lr, 1, NULL_TREE) +DEF_BUILTIN (FFS, 1, int_ftype_int, ffs, (TARGET_EM && TARGET_NORM) || TARGET_HS, attr_const) +DEF_BUILTIN (FLS, 1, int_ftype_int, fls, (TARGET_EM && TARGET_NORM) || TARGET_HS, attr_const) /* ARC SIMD extenssion. */ /* BEGIN SIMD marker. */ -DEF_BUILTIN (SIMD_BEGIN, 0, void_ftype_void, nothing, 0) - -DEF_BUILTIN ( VADDAW, 2, v8hi_ftype_v8hi_v8hi, vaddaw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VADDW, 2, v8hi_ftype_v8hi_v8hi, vaddw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VAVB, 2, v8hi_ftype_v8hi_v8hi, vavb_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VAVRB, 2, v8hi_ftype_v8hi_v8hi, vavrb_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VDIFAW, 2, v8hi_ftype_v8hi_v8hi, vdifaw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VDIFW, 2, v8hi_ftype_v8hi_v8hi, vdifw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMAXAW, 2, v8hi_ftype_v8hi_v8hi, vmaxaw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMAXW, 2, v8hi_ftype_v8hi_v8hi, vmaxw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMINAW, 2, v8hi_ftype_v8hi_v8hi, vminaw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMINW, 2, v8hi_ftype_v8hi_v8hi, vminw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMULAW, 2, v8hi_ftype_v8hi_v8hi, vmulaw_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VMULFAW, 2, v8hi_ftype_v8hi_v8hi, vmulfaw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMULFW, 2, v8hi_ftype_v8hi_v8hi, vmulfw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMULW, 2, v8hi_ftype_v8hi_v8hi, vmulw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VSUBAW, 2, v8hi_ftype_v8hi_v8hi, vsubaw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VSUBW, 2, v8hi_ftype_v8hi_v8hi, vsubw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VSUMMW, 2, v8hi_ftype_v8hi_v8hi, vsummw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VAND, 2, v8hi_ftype_v8hi_v8hi, vand_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VANDAW, 2, v8hi_ftype_v8hi_v8hi, vandaw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VBIC, 2, v8hi_ftype_v8hi_v8hi, vbic_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VBICAW, 2, v8hi_ftype_v8hi_v8hi, vbicaw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VOR, 2, v8hi_ftype_v8hi_v8hi, vor_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VXOR, 2, v8hi_ftype_v8hi_v8hi, vxor_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VXORAW, 2, v8hi_ftype_v8hi_v8hi, vxoraw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VEQW, 2, v8hi_ftype_v8hi_v8hi, veqw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VLEW, 2, v8hi_ftype_v8hi_v8hi, vlew_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VLTW, 2, v8hi_ftype_v8hi_v8hi, vltw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VNEW, 2, v8hi_ftype_v8hi_v8hi, vnew_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMR1AW, 2, v8hi_ftype_v8hi_v8hi, vmr1aw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMR1W, 2, v8hi_ftype_v8hi_v8hi, vmr1w_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMR2AW, 2, v8hi_ftype_v8hi_v8hi, vmr2aw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMR2W, 2, v8hi_ftype_v8hi_v8hi, vmr2w_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMR3AW, 2, v8hi_ftype_v8hi_v8hi, vmr3aw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMR3W, 2, v8hi_ftype_v8hi_v8hi, vmr3w_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMR4AW, 2, v8hi_ftype_v8hi_v8hi, vmr4aw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMR4W, 2, v8hi_ftype_v8hi_v8hi, vmr4w_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMR5AW, 2, v8hi_ftype_v8hi_v8hi, vmr5aw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMR5W, 2, v8hi_ftype_v8hi_v8hi, vmr5w_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMR6AW, 2, v8hi_ftype_v8hi_v8hi, vmr6aw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMR6W, 2, v8hi_ftype_v8hi_v8hi, vmr6w_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMR7AW, 2, v8hi_ftype_v8hi_v8hi, vmr7aw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMR7W, 2, v8hi_ftype_v8hi_v8hi, vmr7w_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMRB, 2, v8hi_ftype_v8hi_v8hi, vmrb_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VH264F, 2, v8hi_ftype_v8hi_v8hi, vh264f_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VH264FT, 2, v8hi_ftype_v8hi_v8hi, vh264ft_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VH264FW, 2, v8hi_ftype_v8hi_v8hi, vh264fw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VVC1F, 2, v8hi_ftype_v8hi_v8hi, vvc1f_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VVC1FT, 2, v8hi_ftype_v8hi_v8hi, vvc1ft_insn, TARGET_SIMD_SET) - -DEF_BUILTIN ( VBADDW, 2, v8hi_ftype_v8hi_int, vbaddw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VBMAXW, 2, v8hi_ftype_v8hi_int, vbmaxw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VBMINW, 2, v8hi_ftype_v8hi_int, vbminw_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VBMULAW, 2, v8hi_ftype_v8hi_int, vbmulaw_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VBMULFW, 2, v8hi_ftype_v8hi_int, vbmulfw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VBMULW, 2, v8hi_ftype_v8hi_int, vbmulw_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VBRSUBW, 2, v8hi_ftype_v8hi_int, vbrsubw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VBSUBW, 2, v8hi_ftype_v8hi_int, vbsubw_insn, TARGET_SIMD_SET) +DEF_BUILTIN (SIMD_BEGIN, 0, void_ftype_void, nothing, 0, NULL_TREE) + +DEF_BUILTIN ( VADDAW, 2, v8hi_ftype_v8hi_v8hi, vaddaw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VADDW, 2, v8hi_ftype_v8hi_v8hi, vaddw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VAVB, 2, v8hi_ftype_v8hi_v8hi, vavb_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VAVRB, 2, v8hi_ftype_v8hi_v8hi, vavrb_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VDIFAW, 2, v8hi_ftype_v8hi_v8hi, vdifaw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VDIFW, 2, v8hi_ftype_v8hi_v8hi, vdifw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMAXAW, 2, v8hi_ftype_v8hi_v8hi, vmaxaw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMAXW, 2, v8hi_ftype_v8hi_v8hi, vmaxw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMINAW, 2, v8hi_ftype_v8hi_v8hi, vminaw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMINW, 2, v8hi_ftype_v8hi_v8hi, vminw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMULAW, 2, v8hi_ftype_v8hi_v8hi, vmulaw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VMULFAW, 2, v8hi_ftype_v8hi_v8hi, vmulfaw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMULFW, 2, v8hi_ftype_v8hi_v8hi, vmulfw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMULW, 2, v8hi_ftype_v8hi_v8hi, vmulw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VSUBAW, 2, v8hi_ftype_v8hi_v8hi, vsubaw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VSUBW, 2, v8hi_ftype_v8hi_v8hi, vsubw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VSUMMW, 2, v8hi_ftype_v8hi_v8hi, vsummw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VAND, 2, v8hi_ftype_v8hi_v8hi, vand_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VANDAW, 2, v8hi_ftype_v8hi_v8hi, vandaw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VBIC, 2, v8hi_ftype_v8hi_v8hi, vbic_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VBICAW, 2, v8hi_ftype_v8hi_v8hi, vbicaw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VOR, 2, v8hi_ftype_v8hi_v8hi, vor_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VXOR, 2, v8hi_ftype_v8hi_v8hi, vxor_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VXORAW, 2, v8hi_ftype_v8hi_v8hi, vxoraw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VEQW, 2, v8hi_ftype_v8hi_v8hi, veqw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VLEW, 2, v8hi_ftype_v8hi_v8hi, vlew_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VLTW, 2, v8hi_ftype_v8hi_v8hi, vltw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VNEW, 2, v8hi_ftype_v8hi_v8hi, vnew_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMR1AW, 2, v8hi_ftype_v8hi_v8hi, vmr1aw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMR1W, 2, v8hi_ftype_v8hi_v8hi, vmr1w_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMR2AW, 2, v8hi_ftype_v8hi_v8hi, vmr2aw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMR2W, 2, v8hi_ftype_v8hi_v8hi, vmr2w_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMR3AW, 2, v8hi_ftype_v8hi_v8hi, vmr3aw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMR3W, 2, v8hi_ftype_v8hi_v8hi, vmr3w_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMR4AW, 2, v8hi_ftype_v8hi_v8hi, vmr4aw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMR4W, 2, v8hi_ftype_v8hi_v8hi, vmr4w_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMR5AW, 2, v8hi_ftype_v8hi_v8hi, vmr5aw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMR5W, 2, v8hi_ftype_v8hi_v8hi, vmr5w_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMR6AW, 2, v8hi_ftype_v8hi_v8hi, vmr6aw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMR6W, 2, v8hi_ftype_v8hi_v8hi, vmr6w_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMR7AW, 2, v8hi_ftype_v8hi_v8hi, vmr7aw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMR7W, 2, v8hi_ftype_v8hi_v8hi, vmr7w_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMRB, 2, v8hi_ftype_v8hi_v8hi, vmrb_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VH264F, 2, v8hi_ftype_v8hi_v8hi, vh264f_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VH264FT, 2, v8hi_ftype_v8hi_v8hi, vh264ft_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VH264FW, 2, v8hi_ftype_v8hi_v8hi, vh264fw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VVC1F, 2, v8hi_ftype_v8hi_v8hi, vvc1f_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VVC1FT, 2, v8hi_ftype_v8hi_v8hi, vvc1ft_insn, TARGET_SIMD_SET, NULL_TREE) + +DEF_BUILTIN ( VBADDW, 2, v8hi_ftype_v8hi_int, vbaddw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VBMAXW, 2, v8hi_ftype_v8hi_int, vbmaxw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VBMINW, 2, v8hi_ftype_v8hi_int, vbminw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VBMULAW, 2, v8hi_ftype_v8hi_int, vbmulaw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VBMULFW, 2, v8hi_ftype_v8hi_int, vbmulfw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VBMULW, 2, v8hi_ftype_v8hi_int, vbmulw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VBRSUBW, 2, v8hi_ftype_v8hi_int, vbrsubw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VBSUBW, 2, v8hi_ftype_v8hi_int, vbsubw_insn, TARGET_SIMD_SET, NULL_TREE) /* Va, Vb, Ic instructions. */ -DEF_BUILTIN ( VASRW, 2, v8hi_ftype_v8hi_int, vasrw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VSR8, 2, v8hi_ftype_v8hi_int, vsr8_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VSR8AW, 2, v8hi_ftype_v8hi_int, vsr8aw_insn, TARGET_SIMD_SET) +DEF_BUILTIN ( VASRW, 2, v8hi_ftype_v8hi_int, vasrw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VSR8, 2, v8hi_ftype_v8hi_int, vsr8_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VSR8AW, 2, v8hi_ftype_v8hi_int, vsr8aw_insn, TARGET_SIMD_SET, NULL_TREE) /* Va, Vb, u6 instructions. */ -DEF_BUILTIN ( VASRRWi, 2, v8hi_ftype_v8hi_int, vasrrwi_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VASRSRWi, 2, v8hi_ftype_v8hi_int, vasrsrwi_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VASRWi, 2, v8hi_ftype_v8hi_int, vasrwi_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VASRPWBi, 2, v8hi_ftype_v8hi_int, vasrpwbi_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VASRRPWBi, 2, v8hi_ftype_v8hi_int, vasrrpwbi_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VSR8AWi, 2, v8hi_ftype_v8hi_int, vsr8awi_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VSR8i, 2, v8hi_ftype_v8hi_int, vsr8i_insn, TARGET_SIMD_SET) +DEF_BUILTIN ( VASRRWi, 2, v8hi_ftype_v8hi_int, vasrrwi_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VASRSRWi, 2, v8hi_ftype_v8hi_int, vasrsrwi_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VASRWi, 2, v8hi_ftype_v8hi_int, vasrwi_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VASRPWBi, 2, v8hi_ftype_v8hi_int, vasrpwbi_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VASRRPWBi, 2, v8hi_ftype_v8hi_int, vasrrpwbi_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VSR8AWi, 2, v8hi_ftype_v8hi_int, vsr8awi_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VSR8i, 2, v8hi_ftype_v8hi_int, vsr8i_insn, TARGET_SIMD_SET, NULL_TREE) /* Va, Vb, u8 (simm) instructions. */ -DEF_BUILTIN ( VMVAW, 2, v8hi_ftype_v8hi_int, vmvaw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMVW, 2, v8hi_ftype_v8hi_int, vmvw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMVZW, 2, v8hi_ftype_v8hi_int, vmvzw_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VD6TAPF, 2, v8hi_ftype_v8hi_int, vd6tapf_insn, TARGET_SIMD_SET) +DEF_BUILTIN ( VMVAW, 2, v8hi_ftype_v8hi_int, vmvaw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMVW, 2, v8hi_ftype_v8hi_int, vmvw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMVZW, 2, v8hi_ftype_v8hi_int, vmvzw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VD6TAPF, 2, v8hi_ftype_v8hi_int, vd6tapf_insn, TARGET_SIMD_SET, NULL_TREE) /* Va, rlimm, u8 (simm) instructions. */ -DEF_BUILTIN (VMOVAW, 2, v8hi_ftype_int_int, vmovaw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VMOVW, 2, v8hi_ftype_int_int, vmovw_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VMOVZW, 2, v8hi_ftype_int_int, vmovzw_insn, TARGET_SIMD_SET) +DEF_BUILTIN (VMOVAW, 2, v8hi_ftype_int_int, vmovaw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VMOVW, 2, v8hi_ftype_int_int, vmovw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VMOVZW, 2, v8hi_ftype_int_int, vmovzw_insn, TARGET_SIMD_SET, NULL_TREE) /* Va, Vb instructions. */ -DEF_BUILTIN ( VABSAW, 1, v8hi_ftype_v8hi, vabsaw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VABSW, 1, v8hi_ftype_v8hi, vabsw_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VADDSUW, 1, v8hi_ftype_v8hi, vaddsuw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VSIGNW, 1, v8hi_ftype_v8hi, vsignw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VEXCH1, 1, v8hi_ftype_v8hi, vexch1_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VEXCH2, 1, v8hi_ftype_v8hi, vexch2_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VEXCH4, 1, v8hi_ftype_v8hi, vexch4_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VUPBAW, 1, v8hi_ftype_v8hi, vupbaw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VUPBW, 1, v8hi_ftype_v8hi, vupbw_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VUPSBAW, 1, v8hi_ftype_v8hi, vupsbaw_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VUPSBW, 1, v8hi_ftype_v8hi, vupsbw_insn, TARGET_SIMD_SET) +DEF_BUILTIN ( VABSAW, 1, v8hi_ftype_v8hi, vabsaw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VABSW, 1, v8hi_ftype_v8hi, vabsw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VADDSUW, 1, v8hi_ftype_v8hi, vaddsuw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VSIGNW, 1, v8hi_ftype_v8hi, vsignw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VEXCH1, 1, v8hi_ftype_v8hi, vexch1_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VEXCH2, 1, v8hi_ftype_v8hi, vexch2_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VEXCH4, 1, v8hi_ftype_v8hi, vexch4_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VUPBAW, 1, v8hi_ftype_v8hi, vupbaw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VUPBW, 1, v8hi_ftype_v8hi, vupbw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VUPSBAW, 1, v8hi_ftype_v8hi, vupsbaw_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VUPSBW, 1, v8hi_ftype_v8hi, vupsbw_insn, TARGET_SIMD_SET, NULL_TREE) /* SIMD special DIb, rlimm, rlimm instructions. */ -DEF_BUILTIN (VDIRUN, 2, void_ftype_int_int, vdirun_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VDORUN, 2, void_ftype_int_int, vdorun_insn, TARGET_SIMD_SET) +DEF_BUILTIN (VDIRUN, 2, void_ftype_int_int, vdirun_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VDORUN, 2, void_ftype_int_int, vdorun_insn, TARGET_SIMD_SET, NULL_TREE) /* SIMD special DIb, limm, rlimm instructions. */ -DEF_BUILTIN (VDIWR, 2, void_ftype_int_int, vdiwr_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VDOWR, 2, void_ftype_int_int, vdowr_insn, TARGET_SIMD_SET) +DEF_BUILTIN (VDIWR, 2, void_ftype_int_int, vdiwr_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VDOWR, 2, void_ftype_int_int, vdowr_insn, TARGET_SIMD_SET, NULL_TREE) /* rlimm instructions. */ -DEF_BUILTIN ( VREC, 1, void_ftype_int, vrec_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VRUN, 1, void_ftype_int, vrun_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VRECRUN, 1, void_ftype_int, vrecrun_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VENDREC, 1, void_ftype_int, vendrec_insn, TARGET_SIMD_SET) +DEF_BUILTIN ( VREC, 1, void_ftype_int, vrec_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VRUN, 1, void_ftype_int, vrun_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VRECRUN, 1, void_ftype_int, vrecrun_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VENDREC, 1, void_ftype_int, vendrec_insn, TARGET_SIMD_SET, NULL_TREE) /* Va, [Ib,u8] instructions. */ -DEF_BUILTIN (VLD32WH, 3, v8hi_ftype_v8hi_int_int, vld32wh_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VLD32WL, 3, v8hi_ftype_v8hi_int_int, vld32wl_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VLD64, 3, v8hi_ftype_v8hi_int_int, vld64_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VLD32, 3, v8hi_ftype_v8hi_int_int, vld32_insn, TARGET_SIMD_SET) +DEF_BUILTIN (VLD32WH, 3, v8hi_ftype_v8hi_int_int, vld32wh_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VLD32WL, 3, v8hi_ftype_v8hi_int_int, vld32wl_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VLD64, 3, v8hi_ftype_v8hi_int_int, vld64_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VLD32, 3, v8hi_ftype_v8hi_int_int, vld32_insn, TARGET_SIMD_SET, NULL_TREE) -DEF_BUILTIN (VLD64W, 2, v8hi_ftype_int_int, vld64w_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VLD128, 2, v8hi_ftype_int_int, vld128_insn, TARGET_SIMD_SET) +DEF_BUILTIN (VLD64W, 2, v8hi_ftype_int_int, vld64w_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VLD128, 2, v8hi_ftype_int_int, vld128_insn, TARGET_SIMD_SET, NULL_TREE) -DEF_BUILTIN (VST128, 3, void_ftype_v8hi_int_int, vst128_insn, TARGET_SIMD_SET) -DEF_BUILTIN ( VST64, 3, void_ftype_v8hi_int_int, vst64_insn, TARGET_SIMD_SET) +DEF_BUILTIN (VST128, 3, void_ftype_v8hi_int_int, vst128_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN ( VST64, 3, void_ftype_v8hi_int_int, vst64_insn, TARGET_SIMD_SET, NULL_TREE) /* Va, [Ib, u8] instructions. */ -DEF_BUILTIN (VST16_N, 4, void_ftype_v8hi_int_int_int, vst16_n_insn, TARGET_SIMD_SET) -DEF_BUILTIN (VST32_N, 4, void_ftype_v8hi_int_int_int, vst32_n_insn, TARGET_SIMD_SET) +DEF_BUILTIN (VST16_N, 4, void_ftype_v8hi_int_int_int, vst16_n_insn, TARGET_SIMD_SET, NULL_TREE) +DEF_BUILTIN (VST32_N, 4, void_ftype_v8hi_int_int_int, vst32_n_insn, TARGET_SIMD_SET, NULL_TREE) -DEF_BUILTIN (VINTI, 1, void_ftype_int, vinti_insn, TARGET_SIMD_SET) +DEF_BUILTIN (VINTI, 1, void_ftype_int, vinti_insn, TARGET_SIMD_SET, NULL_TREE) /* END SIMD marker. */ -DEF_BUILTIN (SIMD_END, 0, void_ftype_void, nothing, 0) +DEF_BUILTIN (SIMD_END, 0, void_ftype_void, nothing, 0, NULL_TREE) /* ARCv2 SIMD instructions that use/clobber the accumulator reg. */ -DEF_BUILTIN (QMACH, 2, long_ftype_v4hi_v4hi, qmach, TARGET_PLUS_QMACW) -DEF_BUILTIN (QMACHU, 2, long_ftype_v4hi_v4hi, qmachu, TARGET_PLUS_QMACW) -DEF_BUILTIN (QMPYH, 2, long_ftype_v4hi_v4hi, qmpyh, TARGET_PLUS_QMACW) -DEF_BUILTIN (QMPYHU, 2, long_ftype_v4hi_v4hi, qmpyhu, TARGET_PLUS_QMACW) +DEF_BUILTIN (QMACH, 2, long_ftype_v4hi_v4hi, qmach, TARGET_PLUS_QMACW, NULL_TREE) +DEF_BUILTIN (QMACHU, 2, long_ftype_v4hi_v4hi, qmachu, TARGET_PLUS_QMACW, NULL_TREE) +DEF_BUILTIN (QMPYH, 2, long_ftype_v4hi_v4hi, qmpyh, TARGET_PLUS_QMACW, NULL_TREE) +DEF_BUILTIN (QMPYHU, 2, long_ftype_v4hi_v4hi, qmpyhu, TARGET_PLUS_QMACW, NULL_TREE) -DEF_BUILTIN (DMACH, 2, int_ftype_v2hi_v2hi, dmach, TARGET_PLUS_DMPY) -DEF_BUILTIN (DMACHU, 2, int_ftype_v2hi_v2hi, dmachu, TARGET_PLUS_DMPY) -DEF_BUILTIN (DMPYH, 2, int_ftype_v2hi_v2hi, dmpyh, TARGET_PLUS_DMPY) -DEF_BUILTIN (DMPYHU, 2, int_ftype_v2hi_v2hi, dmpyhu, TARGET_PLUS_DMPY) +DEF_BUILTIN (DMACH, 2, int_ftype_v2hi_v2hi, dmach, TARGET_PLUS_DMPY, NULL_TREE) +DEF_BUILTIN (DMACHU, 2, int_ftype_v2hi_v2hi, dmachu, TARGET_PLUS_DMPY, NULL_TREE) +DEF_BUILTIN (DMPYH, 2, int_ftype_v2hi_v2hi, dmpyh, TARGET_PLUS_DMPY, NULL_TREE) +DEF_BUILTIN (DMPYHU, 2, int_ftype_v2hi_v2hi, dmpyhu, TARGET_PLUS_DMPY, NULL_TREE) -DEF_BUILTIN (DMACWH, 2, long_ftype_v2si_v2hi, dmacwh, TARGET_PLUS_QMACW) -DEF_BUILTIN (DMACWHU, 2, long_ftype_v2si_v2hi, dmacwhu, TARGET_PLUS_QMACW) +DEF_BUILTIN (DMACWH, 2, long_ftype_v2si_v2hi, dmacwh, TARGET_PLUS_QMACW, NULL_TREE) +DEF_BUILTIN (DMACWHU, 2, long_ftype_v2si_v2hi, dmacwhu, TARGET_PLUS_QMACW, NULL_TREE) -DEF_BUILTIN (VMAC2H, 2, v2si_ftype_v2hi_v2hi, vmac2h, TARGET_PLUS_MACD) -DEF_BUILTIN (VMAC2HU, 2, v2si_ftype_v2hi_v2hi, vmac2hu, TARGET_PLUS_MACD) -DEF_BUILTIN (VMPY2H, 2, v2si_ftype_v2hi_v2hi, vmpy2h, TARGET_PLUS_MACD) -DEF_BUILTIN (VMPY2HU, 2, v2si_ftype_v2hi_v2hi, vmpy2hu, TARGET_PLUS_MACD) +DEF_BUILTIN (VMAC2H, 2, v2si_ftype_v2hi_v2hi, vmac2h, TARGET_PLUS_MACD, NULL_TREE) +DEF_BUILTIN (VMAC2HU, 2, v2si_ftype_v2hi_v2hi, vmac2hu, TARGET_PLUS_MACD, NULL_TREE) +DEF_BUILTIN (VMPY2H, 2, v2si_ftype_v2hi_v2hi, vmpy2h, TARGET_PLUS_MACD, NULL_TREE) +DEF_BUILTIN (VMPY2HU, 2, v2si_ftype_v2hi_v2hi, vmpy2hu, TARGET_PLUS_MACD, NULL_TREE) /* Combined add/sub HS SIMD instructions. */ -DEF_BUILTIN (VADDSUB2H, 2, v2hi_ftype_v2hi_v2hi, addsubv2hi3, TARGET_PLUS_DMPY) -DEF_BUILTIN (VSUBADD2H, 2, v2hi_ftype_v2hi_v2hi, subaddv2hi3, TARGET_PLUS_DMPY) -DEF_BUILTIN (VADDSUB, 2, v2si_ftype_v2si_v2si, addsubv2si3, TARGET_PLUS_QMACW) -DEF_BUILTIN (VSUBADD, 2, v2si_ftype_v2si_v2si, subaddv2si3, TARGET_PLUS_QMACW) -DEF_BUILTIN (VADDSUB4H, 2, v4hi_ftype_v4hi_v4hi, addsubv4hi3, TARGET_PLUS_QMACW) -DEF_BUILTIN (VSUBADD4H, 2, v4hi_ftype_v4hi_v4hi, subaddv4hi3, TARGET_PLUS_QMACW) +DEF_BUILTIN (VADDSUB2H, 2, v2hi_ftype_v2hi_v2hi, addsubv2hi3, TARGET_PLUS_DMPY, NULL_TREE) +DEF_BUILTIN (VSUBADD2H, 2, v2hi_ftype_v2hi_v2hi, subaddv2hi3, TARGET_PLUS_DMPY, NULL_TREE) +DEF_BUILTIN (VADDSUB, 2, v2si_ftype_v2si_v2si, addsubv2si3, TARGET_PLUS_QMACW, NULL_TREE) +DEF_BUILTIN (VSUBADD, 2, v2si_ftype_v2si_v2si, subaddv2si3, TARGET_PLUS_QMACW, NULL_TREE) +DEF_BUILTIN (VADDSUB4H, 2, v4hi_ftype_v4hi_v4hi, addsubv4hi3, TARGET_PLUS_QMACW, NULL_TREE) +DEF_BUILTIN (VSUBADD4H, 2, v4hi_ftype_v4hi_v4hi, subaddv4hi3, TARGET_PLUS_QMACW, NULL_TREE) diff --git a/gcc/config/avr/avr.cc b/gcc/config/avr/avr.cc index 0bdba55..775be80 100644 --- a/gcc/config/avr/avr.cc +++ b/gcc/config/avr/avr.cc @@ -14394,6 +14394,16 @@ avr_output_addr_vec (rtx_insn *labl, rtx table) { FILE *stream = asm_out_file; + // AVR-SD: On functional safety devices, each executed instruction must + // be followed by a valid opcode. This is because instruction validation + // runs at fetch and decode for the next instruction and while the 2-stage + // pipeline is executing the current one. There is no multilib option for + // these devices, so take all multilib variants that contain AVR-SD. + const bool maybe_sd = (AVR_HAVE_JMP_CALL + && (avr_arch_index == ARCH_AVRXMEGA2 + || avr_arch_index == ARCH_AVRXMEGA3)); + bool uses_subsection = false; + app_disable (); // Switch to appropriate (sub)section. @@ -14407,6 +14417,7 @@ avr_output_addr_vec (rtx_insn *labl, rtx table) switch_to_section (current_function_section ()); fprintf (stream, "\t.subsection\t1\n"); + uses_subsection = true; } else { @@ -14429,10 +14440,21 @@ avr_output_addr_vec (rtx_insn *labl, rtx table) AVR_HAVE_JMP_CALL ? "a" : "ax"); } - // Output the label that precedes the table. - ASM_OUTPUT_ALIGN (stream, 1); + if (maybe_sd && uses_subsection) + { + // Insert a valid opcode prior to the first gs() label. + // Any valid opcode will do. Use CLH since it disassembles + // more nicely than NOP = 0x0000. This is all GCC can do. + // Other cases, like inserting CLH after the vector table and + // after the last instruction, are handled by other parts of + // the toolchain. + fprintf (stream, "\tclh\n"); + } + + // Output the label that precedes the table. + char s_labl[40]; targetm.asm_out.generate_internal_label (s_labl, "L", CODE_LABEL_NUMBER (labl)); diff --git a/gcc/config/avr/elf.h b/gcc/config/avr/elf.h index d240f85..e0f8a87 100644 --- a/gcc/config/avr/elf.h +++ b/gcc/config/avr/elf.h @@ -18,6 +18,19 @@ along with GCC; see the file COPYING3. If not see <http://www.gnu.org/licenses/>. */ +/* defaults.h requires HAVE_INITFINI_ARRAY_SUPPORT to be present + in order for attribute "retain" to be recognized. This is due + to some quirks in crtstuff.h -- which isn't even used by avr. + All we need is that Binutils supports the "R"etain section flag. + If that's the case, define SUPPORTS_SHF_GNU_RETAIN so that + defaults.h doesn't define it to 0. */ +#if defined(IN_GCC) && !defined(USED_FOR_TARGET) && !defined(GENERATOR_FILE) +#include "auto-host.h" /* HAVE_GAS_SHF_GNU_RETAIN */ +#if HAVE_GAS_SHF_GNU_RETAIN +#undef SUPPORTS_SHF_GNU_RETAIN +#define SUPPORTS_SHF_GNU_RETAIN 1 +#endif +#endif /* Overriding some definitions from elfos.h for AVR. */ diff --git a/gcc/config/i386/i386.md b/gcc/config/i386/i386.md index 4a2232e..3ea2439 100644 --- a/gcc/config/i386/i386.md +++ b/gcc/config/i386/i386.md @@ -8860,6 +8860,35 @@ (match_dup 0))) (clobber (reg:CC FLAGS_REG))])]) +(define_insn "*add<mode>3_carry_2" + [(set (reg FLAGS_REG) + (compare + (plus:SWI + (plus:SWI + (match_operator:SWI 4 "ix86_carry_flag_operator" + [(match_operand 3 "flags_reg_operand") (const_int 0)]) + (match_operand:SWI 1 "nonimmediate_operand" "%0,0,rm,r")) + (match_operand:SWI 2 "<general_operand>" "<r><i>,<m>,r<i>,<m>")) + (const_int 0))) + (set (match_operand:SWI 0 "nonimmediate_operand" "=<r>m,<r>,r,r") + (plus:SWI + (plus:SWI + (match_op_dup 4 [(match_dup 3) (const_int 0)]) + (match_dup 1)) + (match_dup 2)))] + "ix86_match_ccmode (insn, CCGOCmode) + && ix86_binary_operator_ok (PLUS, <MODE>mode, operands, TARGET_APX_NDD)" + "@ + adc{<imodesuffix>}\t{%2, %0|%0, %2} + adc{<imodesuffix>}\t{%2, %0|%0, %2} + adc{<imodesuffix>}\t{%2, %1, %0|%0, %1, %2} + adc{<imodesuffix>}\t{%2, %1, %0|%0, %1, %2}" + [(set_attr "isa" "*,*,apx_ndd,apx_ndd") + (set_attr "type" "alu") + (set_attr "use_carry" "1") + (set_attr "pent_pair" "pu") + (set_attr "mode" "<MODE>")]) + (define_insn "*add<mode>3_carry_0" [(set (match_operand:SWI 0 "nonimmediate_operand" "=<r>m") (plus:SWI @@ -8874,6 +8903,26 @@ (set_attr "pent_pair" "pu") (set_attr "mode" "<MODE>")]) +(define_insn "*add<mode>3_carry_0_cc" + [(set (reg FLAGS_REG) + (compare + (plus:SWI + (match_operator:SWI 2 "ix86_carry_flag_operator" + [(match_operand 3 "flags_reg_operand") (const_int 0)]) + (match_operand:SWI 1 "nonimmediate_operand" "0")) + (const_int 0))) + (set (match_operand:SWI 0 "nonimmediate_operand" "=<r>m") + (plus:SWI + (match_op_dup 2 [(match_dup 3) (const_int 0)]) + (match_dup 1)))] + "ix86_match_ccmode (insn, CCGOCmode) + && (!MEM_P (operands[0]) || rtx_equal_p (operands[0], operands[1]))" + "adc{<imodesuffix>}\t{$0, %0|%0, 0}" + [(set_attr "type" "alu") + (set_attr "use_carry" "1") + (set_attr "pent_pair" "pu") + (set_attr "mode" "<MODE>")]) + (define_insn "*add<mode>3_carry_0r" [(set (match_operand:SWI 0 "nonimmediate_operand" "=<r>m") (plus:SWI @@ -8888,6 +8937,26 @@ (set_attr "pent_pair" "pu") (set_attr "mode" "<MODE>")]) +(define_insn "*add<mode>3_carry_0r_cc" + [(set (reg FLAGS_REG) + (compare + (plus:SWI + (match_operator:SWI 2 "ix86_carry_flag_unset_operator" + [(match_operand 3 "flags_reg_operand") (const_int 0)]) + (match_operand:SWI 1 "nonimmediate_operand" "0")) + (const_int 0))) + (set (match_operand:SWI 0 "nonimmediate_operand" "=<r>m") + (plus:SWI + (match_op_dup 2 [(match_dup 3) (const_int 0)]) + (match_dup 1)))] + "ix86_match_ccmode (insn, CCGOCmode) + && (!MEM_P (operands[0]) || rtx_equal_p (operands[0], operands[1]))" + "sbb{<imodesuffix>}\t{$-1, %0|%0, -1}" + [(set_attr "type" "alu") + (set_attr "use_carry" "1") + (set_attr "pent_pair" "pu") + (set_attr "mode" "<MODE>")]) + (define_insn "*addqi3_carry_zext<mode>" [(set (match_operand:SWI248x 0 "register_operand" "=r,r") (zero_extend:SWI248x @@ -9456,6 +9525,35 @@ (match_dup 0))) (clobber (reg:CC FLAGS_REG))])]) +(define_insn "*sub<mode>3_carry_2" + [(set (reg FLAGS_REG) + (compare + (minus:SWI + (minus:SWI + (match_operand:SWI 1 "nonimmediate_operand" "0,0,rm,r") + (match_operator:SWI 4 "ix86_carry_flag_operator" + [(match_operand 3 "flags_reg_operand") (const_int 0)])) + (match_operand:SWI 2 "<general_operand>" "<r><i>,<m>,r<i>,<m>")) + (const_int 0))) + (set (match_operand:SWI 0 "nonimmediate_operand" "=<r>m,<r>,r,r") + (minus:SWI + (minus:SWI + (match_dup 1) + (match_op_dup 4 [(match_dup 3) (const_int 0)])) + (match_dup 2)))] + "ix86_match_ccmode (insn, CCGOCmode) + && ix86_binary_operator_ok (MINUS, <MODE>mode, operands, TARGET_APX_NDD)" + "@ + sbb{<imodesuffix>}\t{%2, %0|%0, %2} + sbb{<imodesuffix>}\t{%2, %0|%0, %2} + sbb{<imodesuffix>}\t{%2, %1, %0|%0, %1, %2} + sbb{<imodesuffix>}\t{%2, %1, %0|%0, %1, %2}" + [(set_attr "isa" "*,*,apx_ndd,apx_ndd") + (set_attr "type" "alu") + (set_attr "use_carry" "1") + (set_attr "pent_pair" "pu") + (set_attr "mode" "<MODE>")]) + (define_insn "*sub<mode>3_carry_0" [(set (match_operand:SWI 0 "nonimmediate_operand" "=<r>m") (minus:SWI @@ -9470,6 +9568,26 @@ (set_attr "pent_pair" "pu") (set_attr "mode" "<MODE>")]) +(define_insn "*sub<mode>3_carry_0_cc" + [(set (reg FLAGS_REG) + (compare + (minus:SWI + (match_operand:SWI 1 "nonimmediate_operand" "0") + (match_operator:SWI 2 "ix86_carry_flag_operator" + [(match_operand 3 "flags_reg_operand") (const_int 0)])) + (const_int 0))) + (set (match_operand:SWI 0 "nonimmediate_operand" "=<r>m") + (minus:SWI + (match_dup 1) + (match_op_dup 2 [(match_dup 3) (const_int 0)])))] + "ix86_match_ccmode (insn, CCGOCmode) + && (!MEM_P (operands[0]) || rtx_equal_p (operands[0], operands[1]))" + "sbb{<imodesuffix>}\t{$0, %0|%0, 0}" + [(set_attr "type" "alu") + (set_attr "use_carry" "1") + (set_attr "pent_pair" "pu") + (set_attr "mode" "<MODE>")]) + (define_insn "*sub<mode>3_carry_0r" [(set (match_operand:SWI 0 "nonimmediate_operand" "=<r>m") (minus:SWI @@ -9484,6 +9602,26 @@ (set_attr "pent_pair" "pu") (set_attr "mode" "<MODE>")]) +(define_insn "*sub<mode>3_carry_0r_cc" + [(set (reg FLAGS_REG) + (compare + (minus:SWI + (match_operand:SWI 1 "nonimmediate_operand" "0") + (match_operator:SWI 2 "ix86_carry_flag_unset_operator" + [(match_operand 3 "flags_reg_operand") (const_int 0)])) + (const_int 0))) + (set (match_operand:SWI 0 "nonimmediate_operand" "=<r>m") + (minus:SWI + (match_dup 1) + (match_op_dup 2 [(match_dup 3) (const_int 0)])))] + "ix86_match_ccmode (insn, CCGOCmode) + && (!MEM_P (operands[0]) || rtx_equal_p (operands[0], operands[1]))" + "adc{<imodesuffix>}\t{$-1, %0|%0, -1}" + [(set_attr "type" "alu") + (set_attr "use_carry" "1") + (set_attr "pent_pair" "pu") + (set_attr "mode" "<MODE>")]) + (define_insn "*subqi3_carry_zext<mode>" [(set (match_operand:SWI248x 0 "register_operand" "=r,r") (zero_extend:SWI248x diff --git a/gcc/config/loongarch/loongarch-opts.cc b/gcc/config/loongarch/loongarch-opts.cc index 6e72084..cacfe37 100644 --- a/gcc/config/loongarch/loongarch-opts.cc +++ b/gcc/config/loongarch/loongarch-opts.cc @@ -540,7 +540,7 @@ fallback: /* 5. Target code model */ - t.cmodel = constrained.cmodel ? target->cmodel : CMODEL_NORMAL; + t.cmodel = constrained.cmodel ? target->cmodel : TARGET_DEFAULT_CMODEL; switch (t.cmodel) { diff --git a/gcc/config/loongarch/loongarch.md b/gcc/config/loongarch/loongarch.md index 2f4817d..ba66888 100644 --- a/gcc/config/loongarch/loongarch.md +++ b/gcc/config/loongarch/loongarch.md @@ -1773,21 +1773,23 @@ ;; This attribute used for get connection of scalar mode and corresponding ;; vector mode. -(define_mode_attr cntmap [(SI "v4si") (DI "v2di")]) +(define_mode_attr cntmap [(SI "V4SI") (DI "V2DI")]) -(define_expand "popcount<mode>2" - [(set (match_operand:GPR 0 "register_operand") - (popcount:GPR (match_operand:GPR 1 "register_operand")))] +(define_insn_and_split "popcount<mode>2" + [(set (match_operand:GPR 0 "register_operand" "=f") + (popcount:GPR (match_operand:GPR 1 "register_operand" "f")))] "ISA_HAS_LSX" + "#" + ;; Do the split very lately to work around init-regs unneeded zero- + ;; initialization from init-regs. See PR61810 and all the referenced + ;; issues. + "&& reload_completed" + [(set (match_operand:<cntmap> 0 "register_operand" "=f") + (popcount:<cntmap> + (match_operand:<cntmap> 1 "register_operand" "f")))] { - rtx in = operands[1]; - rtx out = operands[0]; - rtx vreg = <MODE>mode == SImode ? gen_reg_rtx (V4SImode) : - gen_reg_rtx (V2DImode); - emit_insn (gen_lsx_vinsgr2vr_<size> (vreg, in, vreg, GEN_INT (1))); - emit_insn (gen_popcount<cntmap>2 (vreg, vreg)); - emit_insn (gen_lsx_vpickve2gr_<size> (out, vreg, GEN_INT (0))); - DONE; + operands[0] = gen_rtx_REG (<cntmap>mode, REGNO (operands[0])); + operands[1] = gen_rtx_REG (<cntmap>mode, REGNO (operands[1])); }) ;; diff --git a/gcc/config/riscv/riscv.cc b/gcc/config/riscv/riscv.cc index e186c6a..7d723fc 100644 --- a/gcc/config/riscv/riscv.cc +++ b/gcc/config/riscv/riscv.cc @@ -4722,6 +4722,13 @@ riscv_noce_conversion_profitable_p (rtx_insn *seq, if (last_dest) last_dest = dest; } + else if (REG_P (dest) && src == CONST0_RTX (GET_MODE (dest))) + { + /* A GPR set to zero can always be replaced with x0, so any + insn that sets a GPR to zero will eventually be eliminated. */ + riscv_if_info.original_cost += COSTS_N_INSNS (1); + riscv_if_info.max_seq_cost += COSTS_N_INSNS (1); + } else last_dest = NULL_RTX; diff --git a/gcc/config/riscv/riscv.md b/gcc/config/riscv/riscv.md index 640ca5f..1ec15da 100644 --- a/gcc/config/riscv/riscv.md +++ b/gcc/config/riscv/riscv.md @@ -3752,6 +3752,57 @@ [(set_attr "type" "slt") (set_attr "mode" "<X:MODE>")]) +;; We can sometimes do better for unsigned comparisons against +;; values where there's a run of 1s in the LSBs. +;; +(define_split + [(set (match_operand:X 0 "register_operand") + (gtu:X (match_operand:X 1 "register_operand") + (match_operand 2 "const_int_operand"))) + (clobber (match_operand:X 3 "register_operand"))] + "exact_log2 (INTVAL (operands[2]) + 1) >= 0" + [(set (match_dup 3) (lshiftrt:X (match_dup 1) (match_dup 2))) + (set (match_dup 0) (ne:X (match_dup 3) (const_int 0)))] +{ operands[2] = GEN_INT (exact_log2 (INTVAL (operands[2]) + 1)); }) + +(define_split + [(set (match_operand:X 0 "register_operand") + (leu:X (match_operand:X 1 "register_operand") + (match_operand 2 "const_int_operand"))) + (clobber (match_operand:X 3 "register_operand"))] + "exact_log2 (INTVAL (operands[2]) + 1) >= 0" + [(set (match_dup 3) (lshiftrt:X (match_dup 1) (match_dup 2))) + (set (match_dup 0) (eq:X (match_dup 3) (const_int 0)))] +{ operands[2] = GEN_INT (exact_log2 (INTVAL (operands[2]) + 1)); }) + +;; Alternate forms that are ultimately just sltiu +(define_insn "" + [(set (match_operand:X 0 "register_operand" "=r") + (eq:X (zero_extract:X (match_operand:X 1 "register_operand" "r") + (match_operand 2 "const_int_operand") + (match_operand 3 "const_int_operand")) + (const_int 0)))] + "(INTVAL (operands[3]) < 11 + && INTVAL (operands[2]) + INTVAL (operands[3]) == BITS_PER_WORD)" +{ + operands[2] = GEN_INT (HOST_WIDE_INT_1U << INTVAL (operands[3])); + return "sltiu\t%0,%1,%2"; +} + [(set_attr "type" "slt") + (set_attr "mode" "<X:MODE>")]) + +(define_insn "" + [(set (match_operand:X 0 "register_operand" "=r") + (eq:X (lshiftrt:X (match_operand:X 1 "register_operand" "r") + (match_operand 2 "const_int_operand")) + (const_int 0)))] + "INTVAL (operands[2]) < 11" +{ + operands[2] = GEN_INT (HOST_WIDE_INT_1U << INTVAL (operands[2])); + return "sltiu\t%0,%1,%2"; +} + [(set_attr "type" "slt") + (set_attr "mode" "<X:MODE>")]) ;; ;; .................... ;; diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index 9a8c394..95b471d 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,54 @@ +2025-11-05 Nathaniel Shead <nathanieloshead@gmail.com> + + PR c++/121574 + * cp-tree.h (instantiating_tu_local_entity): Declare. + * module.cc (is_tu_local_entity): Extract from depset::hash. + (is_tu_local_value): Likewise. + (has_tu_local_tmpl_arg): Likewise. + (depset::hash::is_tu_local_entity): Remove. + (depset::hash::has_tu_local_tmpl_arg): Remove. + (depset::hash::is_tu_local_value): Remove. + (instantiating_tu_local_entity): New function. + (depset::hash::add_binding_entity): No longer go through + depset::hash to check is_tu_local_entity. + * pt.cc (complain_about_tu_local_entity): Remove. + (tsubst): Use instantiating_tu_local_entity. + (tsubst_expr): Likewise. + +2025-11-05 Nathaniel Shead <nathanieloshead@gmail.com> + + PR c++/121574 + * module.cc (depset::disc_bits): Replace 'DB_REFS_TU_LOCAL_BIT' + and 'DB_EXPOSURE_BIT' with new four flags + 'DB_{REF,EXPOSE}_{GLOBAL,PURVIEW}_BIT'. + (depset::is_tu_local): Support checking either for only purview + TU-local entities or any entity described TU-local by standard. + (depset::refs_tu_local): Likewise. + (depset::is_exposure): Likewise. + (depset::hash::make_dependency): A constant initialized to a + TU-local variable is always considered a purview exposure. + (is_exposure_of_member_type): Adjust sanity checks to handle if + we ever relax requirements for TU-local types. + (depset::hash::add_dependency): Differentiate referencing + purview or GMF TU-local entities. + (depset::hash::diagnose_bad_internal_ref): New function. + (depset::hash::diagnose_template_names_tu_local): New function. + (depset::hash::finalize_dependencies): Handle new warnings that + might be needed for GMF TU-local entities. + +2025-11-04 Nathaniel Shead <nathanieloshead@gmail.com> + + PR c++/122253 + * decl2.cc (min_vis_expr_r): Don't mark no-linkage declarations + as VISIBILITY_ANON. + +2025-11-04 David Malcolm <dmalcolm@redhat.com> + + * parser.cc (enum non_integral_constant): Fix typo + "an decrement" -> "a decrement" in comment. + (cp_parser_non_integral_constant_expression): Likewise in error + message. + 2025-11-03 Jason Merrill <jason@redhat.com> * name-lookup.cc (name_lookup::adl_class_fns): Include all diff --git a/gcc/cp/cp-tree.h b/gcc/cp/cp-tree.h index 8c211ab..4f077e7 100644 --- a/gcc/cp/cp-tree.h +++ b/gcc/cp/cp-tree.h @@ -7745,6 +7745,8 @@ extern module_state *get_module (tree name, module_state *parent = NULL, bool partition = false); extern bool module_may_redeclare (tree olddecl, tree newdecl = NULL); +extern bool instantiating_tu_local_entity (tree decl); + extern bool module_global_init_needed (); extern bool module_determine_import_inits (); extern void module_add_import_initializers (); diff --git a/gcc/cp/decl2.cc b/gcc/cp/decl2.cc index 0073f83..9e135af 100644 --- a/gcc/cp/decl2.cc +++ b/gcc/cp/decl2.cc @@ -2885,7 +2885,12 @@ min_vis_expr_r (tree *tp, int */*walk_subtrees*/, void *data) break; } addressable: - if (! TREE_PUBLIC (t)) + if (decl_linkage (t) == lk_none) + tpvis = type_visibility (TREE_TYPE (t)); + /* Decls that have had their visibility constrained will report + as external linkage, but we still want to transitively constrain + if we refer to them, so just check TREE_PUBLIC instead. */ + else if (!TREE_PUBLIC (t)) tpvis = VISIBILITY_ANON; else tpvis = DECL_VISIBILITY (t); diff --git a/gcc/cp/module.cc b/gcc/cp/module.cc index e9cacf1..0610ee5 100644 --- a/gcc/cp/module.cc +++ b/gcc/cp/module.cc @@ -2365,10 +2365,11 @@ private: DB_KIND_BITS = EK_BITS, DB_DEFN_BIT = DB_KIND_BIT + DB_KIND_BITS, DB_IS_PENDING_BIT, /* Is a maybe-pending entity. */ - DB_TU_LOCAL_BIT, /* It is a TU-local entity. */ - DB_REFS_TU_LOCAL_BIT, /* Refers to a TU-local entity (but is not - necessarily an exposure.) */ - DB_EXPOSURE_BIT, /* Exposes a TU-local entity. */ + DB_TU_LOCAL_BIT, /* Is a TU-local entity. */ + DB_REF_GLOBAL_BIT, /* Refers to a GMF TU-local entity. */ + DB_REF_PURVIEW_BIT, /* Refers to a purview TU-local entity. */ + DB_EXPOSE_GLOBAL_BIT, /* Exposes a GMF TU-local entity. */ + DB_EXPOSE_PURVIEW_BIT, /* Exposes a purview TU-local entity. */ DB_IMPORTED_BIT, /* An imported entity. */ DB_UNREACHED_BIT, /* A yet-to-be reached entity. */ DB_MAYBE_RECURSIVE_BIT, /* An entity maybe in a recursive cluster. */ @@ -2458,19 +2459,40 @@ public: || (get_entity_kind () == EK_DECL && get_flag_bit<DB_IS_PENDING_BIT> ())); } + public: - bool is_tu_local () const + /* Only consider global module entities as being TU-local + when STRICT is set; otherwise, as an extension we support + emitting declarations referencing TU-local GMF entities + (and only check purview entities), to assist in migration. */ + bool is_tu_local (bool strict = false) const { - return get_flag_bit<DB_TU_LOCAL_BIT> (); + /* Non-strict is only intended for migration purposes, so + for simplicity's sake we only care about whether this is + a non-purview variable or function at namespace scope; + these are the most common cases (coming from C), and + that way we don't have to care about diagnostics for + nested types and so forth. */ + tree inner = STRIP_TEMPLATE (get_entity ()); + return (get_flag_bit<DB_TU_LOCAL_BIT> () + && (strict + || !VAR_OR_FUNCTION_DECL_P (inner) + || !NAMESPACE_SCOPE_P (inner) + || (DECL_LANG_SPECIFIC (inner) + && DECL_MODULE_PURVIEW_P (inner)))); } - bool refs_tu_local () const + bool refs_tu_local (bool strict = false) const { - return get_flag_bit<DB_REFS_TU_LOCAL_BIT> (); + return (get_flag_bit<DB_REF_PURVIEW_BIT> () + || (strict && get_flag_bit <DB_REF_GLOBAL_BIT> ())); } - bool is_exposure () const + bool is_exposure (bool strict = false) const { - return get_flag_bit<DB_EXPOSURE_BIT> (); + return (get_flag_bit<DB_EXPOSE_PURVIEW_BIT> () + || (strict && get_flag_bit <DB_EXPOSE_GLOBAL_BIT> ())); } + +public: bool is_import () const { return get_flag_bit<DB_IMPORTED_BIT> (); @@ -2642,11 +2664,6 @@ public: void add_namespace_context (depset *, tree ns); private: - bool has_tu_local_tmpl_arg (tree decl, tree args, bool explain); - bool is_tu_local_entity (tree decl, bool explain = false); - bool is_tu_local_value (tree decl, tree expr, bool explain = false); - - private: static bool add_binding_entity (tree, WMB_Flags, void *); public: @@ -2662,6 +2679,10 @@ public: void find_dependencies (module_state *); bool finalize_dependencies (); vec<depset *> connect (); + + private: + bool diagnose_bad_internal_ref (depset *dep, bool strict = false); + bool diagnose_template_names_tu_local (depset *dep, bool strict = false); }; public: @@ -13908,11 +13929,15 @@ depset::hash::find_binding (tree ctx, tree name) return slot ? *slot : NULL; } +static bool is_tu_local_entity (tree decl, bool explain = false); +static bool is_tu_local_value (tree decl, tree expr, bool explain = false); +static bool has_tu_local_tmpl_arg (tree decl, tree args, bool explain); + /* Returns true if DECL is a TU-local entity, as defined by [basic.link]. If EXPLAIN is true, emit an informative note about why DECL is TU-local. */ -bool -depset::hash::is_tu_local_entity (tree decl, bool explain/*=false*/) +static bool +is_tu_local_entity (tree decl, bool explain/*=false*/) { gcc_checking_assert (DECL_P (decl)); location_t loc = DECL_SOURCE_LOCATION (decl); @@ -14078,8 +14103,8 @@ depset::hash::is_tu_local_entity (tree decl, bool explain/*=false*/) /* Helper for is_tu_local_entity. Returns true if one of the ARGS of DECL is TU-local. Emits an explanation if EXPLAIN is true. */ -bool -depset::hash::has_tu_local_tmpl_arg (tree decl, tree args, bool explain) +static bool +has_tu_local_tmpl_arg (tree decl, tree args, bool explain) { if (!args || TREE_CODE (args) != TREE_VEC) return false; @@ -14128,8 +14153,8 @@ depset::hash::has_tu_local_tmpl_arg (tree decl, tree args, bool explain) /* Returns true if EXPR (part of the initializer for DECL) is a TU-local value or object. Emits an explanation if EXPLAIN is true. */ -bool -depset::hash::is_tu_local_value (tree decl, tree expr, bool explain) +static bool +is_tu_local_value (tree decl, tree expr, bool explain/*=false*/) { if (!expr) return false; @@ -14182,6 +14207,63 @@ depset::hash::is_tu_local_value (tree decl, tree expr, bool explain) return false; } +/* Complains if DECL is a TU-local entity imported from a named module. + Returns TRUE if instantiation should fail. */ + +bool +instantiating_tu_local_entity (tree decl) +{ + if (!modules_p ()) + return false; + + if (TREE_CODE (decl) == TU_LOCAL_ENTITY) + { + auto_diagnostic_group d; + error ("instantiation exposes TU-local entity %qD", + TU_LOCAL_ENTITY_NAME (decl)); + inform (TU_LOCAL_ENTITY_LOCATION (decl), "declared here"); + return true; + } + + /* Currently, only TU-local variables and functions will be emitted + from named modules. */ + if (!VAR_OR_FUNCTION_DECL_P (decl)) + return false; + + /* From this point we will only be emitting warnings; if we're not + warning about this case then there's no need to check further. */ + if (!warn_expose_global_module_tu_local + || !warning_enabled_at (DECL_SOURCE_LOCATION (decl), + OPT_Wexpose_global_module_tu_local)) + return false; + + if (!is_tu_local_entity (decl)) + return false; + + tree origin = get_originating_module_decl (decl); + if (!DECL_LANG_SPECIFIC (origin) + || !DECL_MODULE_IMPORT_P (origin)) + return false; + + /* Referencing TU-local entities from a header is generally OK. + We don't have an easy way to detect if this declaration came + from a header via a separate named module, but we can just + ignore that case for warning purposes. */ + unsigned index = import_entity_index (origin); + module_state *mod = import_entity_module (index); + if (mod->is_header ()) + return false; + + auto_diagnostic_group d; + warning (OPT_Wexpose_global_module_tu_local, + "instantiation exposes TU-local entity %qD", decl); + inform (DECL_SOURCE_LOCATION (decl), "declared here"); + + /* We treat TU-local entities from the GMF as not actually being + TU-local as an extension, so allow instantation to proceed. */ + return false; +} + /* DECL is a newly discovered dependency. Create the depset, if it doesn't already exist. Add it to the worklist if so. @@ -14335,8 +14417,14 @@ depset::hash::make_dependency (tree decl, entity_kind ek) if (DECL_DECLARED_CONSTEXPR_P (decl) || DECL_INLINE_VAR_P (decl)) /* A constexpr variable initialized to a TU-local value, - or an inline value (PR c++/119996), is an exposure. */ - dep->set_flag_bit<DB_EXPOSURE_BIT> (); + or an inline value (PR c++/119996), is an exposure. + + For simplicity, we don't support "non-strict" TU-local + values: even if the TU-local entity we refer to in the + initialiser is in the GMF, we still won't consider this + valid in constant expressions in other TUs, and so + complain accordingly. */ + dep->set_flag_bit<DB_EXPOSE_PURVIEW_BIT> (); } } @@ -14426,11 +14514,13 @@ depset::hash::make_dependency (tree decl, entity_kind ek) static bool is_exposure_of_member_type (depset *source, depset *ref) { - gcc_checking_assert (source->refs_tu_local () && ref->is_tu_local ()); + gcc_checking_assert (source->refs_tu_local (/*strict=*/true) + && ref->is_tu_local (/*strict=*/true)); tree source_entity = STRIP_TEMPLATE (source->get_entity ()); tree ref_entity = STRIP_TEMPLATE (ref->get_entity ()); - if (source_entity + if (!source->is_tu_local (/*strict=*/true) + && source_entity && ref_entity && DECL_IMPLICIT_TYPEDEF_P (source_entity) && DECL_IMPLICIT_TYPEDEF_P (ref_entity) @@ -14453,11 +14543,20 @@ depset::hash::add_dependency (depset *dep) gcc_checking_assert (current && !is_key_order ()); current->deps.safe_push (dep); - if (dep->is_tu_local ()) + if (dep->is_tu_local (/*strict=*/true)) { - current->set_flag_bit<DB_REFS_TU_LOCAL_BIT> (); + if (dep->is_tu_local ()) + current->set_flag_bit<DB_REF_PURVIEW_BIT> (); + else + current->set_flag_bit<DB_REF_GLOBAL_BIT> (); + if (!ignore_tu_local && !is_exposure_of_member_type (current, dep)) - current->set_flag_bit<DB_EXPOSURE_BIT> (); + { + if (dep->is_tu_local ()) + current->set_flag_bit<DB_EXPOSE_PURVIEW_BIT> (); + else + current->set_flag_bit<DB_EXPOSE_GLOBAL_BIT> (); + } } if (current->get_entity_kind () == EK_USING @@ -14581,7 +14680,7 @@ depset::hash::add_binding_entity (tree decl, WMB_Flags flags, void *data_) return false; bool internal_decl = false; - if (!header_module_p () && data->hash->is_tu_local_entity (decl)) + if (!header_module_p () && is_tu_local_entity (decl)) { /* A TU-local entity. For ADL we still need to create bindings for internal-linkage functions attached to a named module. */ @@ -15342,6 +15441,128 @@ template_has_explicit_inst (tree tmpl) return false; } +/* Complain about DEP that exposes a TU-local entity. + + If STRICT, DEP only referenced entities from the GMF. Returns TRUE + if we explained anything. */ + +bool +depset::hash::diagnose_bad_internal_ref (depset *dep, bool strict) +{ + tree decl = dep->get_entity (); + + /* Don't need to walk if we're not going to be emitting + any diagnostics anyway. */ + if (strict && !warning_enabled_at (DECL_SOURCE_LOCATION (decl), + OPT_Wexpose_global_module_tu_local)) + return false; + + for (depset *rdep : dep->deps) + if (!rdep->is_binding () && rdep->is_tu_local (strict) + && !is_exposure_of_member_type (dep, rdep)) + { + // FIXME:QOI Better location information? We're + // losing, so it doesn't matter about efficiency. + tree exposed = rdep->get_entity (); + auto_diagnostic_group d; + if (strict) + { + /* Allow suppressing the warning from the point of declaration + of the otherwise-exposed decl, for cases we know that + exposures will never be 'bad'. */ + if (warning_enabled_at (DECL_SOURCE_LOCATION (exposed), + OPT_Wexpose_global_module_tu_local) + && pedwarn (DECL_SOURCE_LOCATION (decl), + OPT_Wexpose_global_module_tu_local, + "%qD exposes TU-local entity %qD", decl, exposed)) + { + bool informed = is_tu_local_entity (exposed, /*explain=*/true); + gcc_checking_assert (informed); + return true; + } + } + else + { + error_at (DECL_SOURCE_LOCATION (decl), + "%qD exposes TU-local entity %qD", decl, exposed); + bool informed = is_tu_local_entity (exposed, /*explain=*/true); + gcc_checking_assert (informed); + if (dep->is_tu_local (/*strict=*/true)) + inform (DECL_SOURCE_LOCATION (decl), + "%qD is also TU-local but has been exposed elsewhere", + decl); + return true; + } + } + + return false; +} + +/* Warn about a template DEP that references a TU-local entity. + + If STRICT, DEP only referenced entities from the GMF. Returns TRUE + if we explained anything. */ + +bool +depset::hash::diagnose_template_names_tu_local (depset *dep, bool strict) +{ + tree decl = dep->get_entity (); + + /* Don't bother walking if we know we won't be emitting anything. */ + if (!warning_enabled_at (DECL_SOURCE_LOCATION (decl), + OPT_Wtemplate_names_tu_local) + /* Only warn strictly if users haven't silenced this warning here. */ + || (strict && !warning_enabled_at (DECL_SOURCE_LOCATION (decl), + OPT_Wexpose_global_module_tu_local))) + return false; + + /* Friend decls in a class body are ignored, but this is harmless: + it should not impact any consumers. */ + if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl))) + return false; + + /* We should now only be warning about templates. */ + gcc_checking_assert + (TREE_CODE (decl) == TEMPLATE_DECL + && VAR_OR_FUNCTION_DECL_P (DECL_TEMPLATE_RESULT (decl))); + + /* Don't warn if we've seen any explicit instantiation definitions, + the intent might be for importers to only use those. */ + if (template_has_explicit_inst (decl)) + return false; + + for (depset *rdep : dep->deps) + if (!rdep->is_binding () && rdep->is_tu_local (strict)) + { + tree ref = rdep->get_entity (); + auto_diagnostic_group d; + if (strict) + { + if (warning_enabled_at (DECL_SOURCE_LOCATION (ref), + OPT_Wexpose_global_module_tu_local) + && warning_at (DECL_SOURCE_LOCATION (decl), + OPT_Wtemplate_names_tu_local, + "%qD refers to TU-local entity %qD, which may " + "cause issues when instantiating in other TUs", + decl, ref)) + { + is_tu_local_entity (ref, /*explain=*/true); + return true; + } + } + else if (warning_at (DECL_SOURCE_LOCATION (decl), + OPT_Wtemplate_names_tu_local, + "%qD refers to TU-local entity %qD and cannot " + "be instantiated in other TUs", decl, ref)) + { + is_tu_local_entity (ref, /*explain=*/true); + return true; + } + } + + return false; +} + /* Sort the bindings, issue errors about bad internal refs. */ bool @@ -15366,30 +15587,21 @@ depset::hash::finalize_dependencies () if (CHECKING_P) for (depset *entity : dep->deps) gcc_checking_assert (!entity->is_import ()); + continue; } - else if (dep->is_exposure () && !dep->is_tu_local ()) - { - ok = false; - bool explained = false; - tree decl = dep->get_entity (); - for (depset *rdep : dep->deps) - if (!rdep->is_binding () - && rdep->is_tu_local () - && !is_exposure_of_member_type (dep, rdep)) - { - // FIXME:QOI Better location information? We're - // losing, so it doesn't matter about efficiency - tree exposed = rdep->get_entity (); - auto_diagnostic_group d; - error_at (DECL_SOURCE_LOCATION (decl), - "%qD exposes TU-local entity %qD", decl, exposed); - bool informed = is_tu_local_entity (exposed, /*explain=*/true); - gcc_checking_assert (informed); - explained = true; - break; - } + /* Otherwise, we'll check for bad internal refs. + Don't complain about any references from TU-local entities. */ + if (dep->is_tu_local ()) + continue; + if (dep->is_exposure ()) + { + bool explained = diagnose_bad_internal_ref (dep); + + /* A TU-local variable will always be considered an exposure, + so we don't have to worry about strict-only handling. */ + tree decl = dep->get_entity (); if (!explained && VAR_P (decl) && (DECL_DECLARED_CONSTEXPR_P (decl) @@ -15414,42 +15626,34 @@ depset::hash::finalize_dependencies () explained = true; } - /* We should have emitted an error above. */ + /* We should have emitted an error above, unless the warning was + silenced. */ gcc_checking_assert (explained); + ok = false; + continue; } - else if (warn_template_names_tu_local - && dep->refs_tu_local () && !dep->is_tu_local ()) - { - tree decl = dep->get_entity (); - /* Friend decls in a class body are ignored, but this is harmless: - it should not impact any consumers. */ - if (RECORD_OR_UNION_TYPE_P (TREE_TYPE (decl))) - continue; - - /* We should now only be warning about templates. */ - gcc_checking_assert - (TREE_CODE (decl) == TEMPLATE_DECL - && VAR_OR_FUNCTION_DECL_P (DECL_TEMPLATE_RESULT (decl))); + /* In all other cases, we're just warning (rather than erroring). + We don't want to do too much warning, so let's just bail after + the first warning we successfully emit. */ + if (warn_expose_global_module_tu_local + && !dep->is_tu_local (/*strict=*/true) + && dep->is_exposure (/*strict=*/true) + && diagnose_bad_internal_ref (dep, /*strict=*/true)) + continue; - /* Don't warn if we've seen any explicit instantiation definitions, - the intent might be for importers to only use those. */ - if (template_has_explicit_inst (decl)) - continue; + if (warn_template_names_tu_local + && dep->refs_tu_local () + && diagnose_template_names_tu_local (dep)) + continue; - for (depset *rdep : dep->deps) - if (!rdep->is_binding () && rdep->is_tu_local ()) - { - tree ref = rdep->get_entity (); - auto_diagnostic_group d; - if (warning_at (DECL_SOURCE_LOCATION (decl), - OPT_Wtemplate_names_tu_local, - "%qD refers to TU-local entity %qD and cannot " - "be instantiated in other TUs", decl, ref)) - is_tu_local_entity (ref, /*explain=*/true); - break; - } - } + if (warn_template_names_tu_local + && warn_expose_global_module_tu_local + && !dep->is_tu_local (/*strict=*/true) + && dep->refs_tu_local (/*strict=*/true) + && !dep->is_exposure (/*strict=*/true) + && diagnose_template_names_tu_local (dep, /*strict=*/true)) + continue; } return ok; diff --git a/gcc/cp/pt.cc b/gcc/cp/pt.cc index f61223f..c233bb9 100644 --- a/gcc/cp/pt.cc +++ b/gcc/cp/pt.cc @@ -9941,17 +9941,6 @@ add_pending_template (tree d) pop_tinst_level (); } -/* Emit a diagnostic about instantiating a reference to TU-local entity E. */ - -static void -complain_about_tu_local_entity (tree e) -{ - auto_diagnostic_group d; - error ("instantiation exposes TU-local entity %qD", - TU_LOCAL_ENTITY_NAME (e)); - inform (TU_LOCAL_ENTITY_LOCATION (e), "declared here"); -} - /* Return a TEMPLATE_ID_EXPR corresponding to the indicated FNS and ARGLIST. Valid choices for FNS are given in the cp-tree.def documentation for TEMPLATE_ID_EXPR. */ @@ -16614,12 +16603,9 @@ tsubst (tree t, tree args, tsubst_flags_t complain, tree in_decl) return t; /* Any instantiation of a template containing a TU-local entity is an - exposure, so always issue a hard error irrespective of complain. */ - if (TREE_CODE (t) == TU_LOCAL_ENTITY) - { - complain_about_tu_local_entity (t); - return error_mark_node; - } + exposure, so always issue a diagnostic irrespective of complain. */ + if (instantiating_tu_local_entity (t)) + return error_mark_node; tsubst_flags_t tst_ok_flag = (complain & tf_tst_ok); complain &= ~tf_tst_ok; @@ -20865,6 +20851,9 @@ tsubst_expr (tree t, tree args, tsubst_flags_t complain, tree in_decl) tsubst_flags_t no_name_lookup_flag = (complain & tf_no_name_lookup); complain &= ~tf_no_name_lookup; + if (instantiating_tu_local_entity (t)) + RETURN (error_mark_node); + if (!no_name_lookup_flag) if (tree d = maybe_dependent_member_ref (t, args, complain, in_decl)) return d; @@ -22507,11 +22496,8 @@ tsubst_expr (tree t, tree args, tsubst_flags_t complain, tree in_decl) case OVERLOAD: if (modules_p ()) for (tree ovl : lkp_range (t)) - if (TREE_CODE (ovl) == TU_LOCAL_ENTITY) - { - complain_about_tu_local_entity (ovl); - RETURN (error_mark_node); - } + if (instantiating_tu_local_entity (ovl)) + RETURN (error_mark_node); RETURN (t); case TEMPLATE_DECL: @@ -22791,10 +22777,6 @@ tsubst_expr (tree t, tree args, tsubst_flags_t complain, tree in_decl) RETURN (op); } - case TU_LOCAL_ENTITY: - complain_about_tu_local_entity (t); - RETURN (error_mark_node); - default: /* Handle Objective-C++ constructs, if appropriate. */ if (tree subst = objcp_tsubst_expr (t, args, complain, in_decl)) diff --git a/gcc/diagnostics/paths.cc b/gcc/diagnostics/paths.cc index 824b810..8e29dae 100644 --- a/gcc/diagnostics/paths.cc +++ b/gcc/diagnostics/paths.cc @@ -97,6 +97,22 @@ event::meaning::maybe_get_verb_str (enum verb v) return "branch"; case verb::danger: return "danger"; + + /* Special control flow operations. + + These are not part of SARIF v2.1.0 section 3.38.8, but the + spec allows other values; see + https://github.com/oasis-tcs/sarif-spec/issues/735 */ + case verb::throw_: + return "throw"; + case verb::catch_: + return "catch"; + case verb::unwind_: + return "unwind"; + case verb::setjmp_: + return "setjmp"; + case verb::longjmp_: + return "longjmp"; } } diff --git a/gcc/diagnostics/paths.h b/gcc/diagnostics/paths.h index d30c420..f7dff8d 100644 --- a/gcc/diagnostics/paths.h +++ b/gcc/diagnostics/paths.h @@ -96,7 +96,14 @@ class event return_, branch, - danger + danger, + + // Special control flow operations: + throw_, + catch_, + unwind_, // unwinding stack frame(s) during exception-handling + setjmp_, + longjmp_ }; enum class noun { @@ -131,6 +138,10 @@ class event m_property (property::unknown) { } + meaning (enum verb verb) + : m_verb (verb), m_noun (noun::unknown), m_property (property::unknown) + { + } meaning (enum verb verb, enum noun noun) : m_verb (verb), m_noun (noun), m_property (property::unknown) { diff --git a/gcc/doc/extend.texi b/gcc/doc/extend.texi index 7427825..a5b97f3 100644 --- a/gcc/doc/extend.texi +++ b/gcc/doc/extend.texi @@ -31,7 +31,6 @@ extensions, accepted by GCC in C90 mode and in C++. * Thread-Local:: Per-thread variables. * OpenMP:: Multiprocessing extensions. * OpenACC:: Extensions for offloading code to accelerator devices. -* _Countof:: The number of elements of arrays. * Inline:: Defining inline functions (as fast as macros). * Volatiles:: What constitutes an access to a volatile object. * Using Assembly Language with C:: Instructions and extensions for interfacing C with assembler. @@ -10890,36 +10889,6 @@ library. @xref{OpenMP and OpenACC Options}, for additional options useful with @option{-fopenacc}. -@node _Countof -@section Determining the Number of Elements of Arrays -@cindex _Countof -@cindex number of elements - -The keyword @code{_Countof} determines -the number of elements of an array operand. -Its syntax is similar to @code{sizeof}. -The operand must be -a parenthesized complete array type name -or an expression of such a type. -For example: - -@smallexample -int a[n]; -_Countof (a); // returns n -_Countof (int [7][3]); // returns 7 -@end smallexample - -The result of this operator is an integer constant expression, -unless the array has a variable number of elements. -The operand is only evaluated -if the array has a variable number of elements. -For example: - -@smallexample -_Countof (int [7][n++]); // integer constant expression -_Countof (int [n++][7]); // run-time value; n++ is evaluated -@end smallexample - @node Inline @section An Inline Function is As Fast As a Macro @cindex inline functions @@ -13341,6 +13310,7 @@ C and/or C++ standards, while others remain specific to GNU C. * Labels as Values:: Getting pointers to labels, and computed gotos. * Nested Functions:: Nested functions in GNU C. * Typeof:: @code{typeof}: referring to the type of an expression. +* _Countof:: Determining the number of elements of arrays * Offsetof:: Special syntax for @code{offsetof}. * Alignment:: Determining the alignment of a function, type or variable. * Enum Extensions:: Forward declarations and specifying the underlying type. @@ -13977,6 +13947,36 @@ evaluated only once when using @code{__auto_type}, but twice if @code{typeof} is used. @end itemize +@node _Countof +@subsection Determining the Number of Elements of Arrays +@findex _Countof +@findex number of elements + +The keyword @code{_Countof} determines +the number of elements of an array operand. +Its syntax is similar to @code{sizeof}. +The operand must be +a parenthesized complete array type name +or an expression of such a type. +For example: + +@smallexample +int a[n]; +_Countof (a); // returns n +_Countof (int [7][3]); // returns 7 +@end smallexample + +The result of this operator is an integer constant expression, +unless the array has a variable number of elements. +The operand is only evaluated +if the array has a variable number of elements. +For example: + +@smallexample +_Countof (int [7][n++]); // integer constant expression +_Countof (int [n++][7]); // run-time value; n++ is evaluated +@end smallexample + @node Offsetof @subsection Support for @code{offsetof} @findex __builtin_offsetof diff --git a/gcc/doc/install.texi b/gcc/doc/install.texi index 50cefa1..d1068dc 100644 --- a/gcc/doc/install.texi +++ b/gcc/doc/install.texi @@ -1615,7 +1615,7 @@ Use little endian by default. Provide a multilib for big endian. @item --with-cmodel=@var{cmodel} Specify what code model to use by default. -Currently only implemented for riscv*-*-*. +Currently only implemented for loongarch*-*-* and riscv*-*-*. @item --enable-threads Specify that the target diff --git a/gcc/doc/invoke.texi b/gcc/doc/invoke.texi index 32b9c48..07a21fd 100644 --- a/gcc/doc/invoke.texi +++ b/gcc/doc/invoke.texi @@ -257,7 +257,8 @@ in the following sections. -Wdeprecated-copy -Wdeprecated-copy-dtor -Wno-deprecated-enum-enum-conversion -Wno-deprecated-enum-float-conversion -Weffc++ -Wno-elaborated-enum-base --Wno-exceptions -Wextra-semi -Wno-global-module -Wno-inaccessible-base +-Wno-exceptions -Wno-expose-global-module-tu-local -Wno-external-tu-local +-Wextra-semi -Wno-global-module -Wno-inaccessible-base -Wno-inherited-variadic-ctor -Wno-init-list-lifetime -Winvalid-constexpr -Winvalid-imported-macros -Wno-invalid-offsetof -Wno-literal-suffix @@ -272,7 +273,7 @@ in the following sections. -Woverloaded-virtual -Wno-pmf-conversions -Wself-move -Wsign-promo -Wsized-deallocation -Wsuggest-final-methods -Wsuggest-final-types -Wsuggest-override -Wno-template-body --Wno-template-id-cdtor -Wtemplate-names-tu-local -Wno-external-tu-local +-Wno-template-id-cdtor -Wtemplate-names-tu-local -Wno-terminate -Wno-vexing-parse -Wvirtual-inheritance -Wno-virtual-move-assign -Wvolatile} @@ -4759,6 +4760,29 @@ The presence of an explicit instantiation silences the warning. This flag is enabled by @option{-Wextra}. +@opindex Wexpose-global-module-tu-local +@opindex Wno-expose-global-module-tu-local +@item -Wno-expose-global-module-tu-local +An exposure of a translation-unit-local entity from a module interface is +invalid, as this may cause ODR violations and manifest in link errors or other +unexpected behaviour. However, many existing libraries declare TU-local +entities in their interface, and avoiding exposures of these entities may be +difficult in some cases. + +As an extension, GCC allows exposures of internal variables and functions that +were declared in the global module fragment. This warning indicates when such +an invalid exposure has occurred, and can be silenced using diagnostic pragmas +either at the site of the exposure, or at the point of declaration of the +internal declaration. + +When combined with @option{-Wtemplate-names-tu-local}, GCC will also warn about +non-exposure references to TU-local entities in template bodies. Such templates +can still be instantiated in other TUs but the above risks regarding exposures +of translation-unit-local entities apply. + +This warning is enabled by default, and is upgraded to an error by +@option{-pedantic-errors}. + @opindex Wexternal-tu-local @opindex Wno-external-tu-local @item -Wno-external-tu-local @@ -28520,6 +28544,8 @@ be within 2GB addressing space. @item medium The text segment and data segment must be within 2GB addressing space. +This is the default code model unless GCC has been configured with +@option{--with-cmodel=} specifying a different default code model. @item large (Not implemented yet) @@ -28528,7 +28554,6 @@ This mode does not limit the size of the code segment and data segment. The @option{-mcmodel=extreme} option is incompatible with @option{-fplt} and/or @option{-mexplicit-relocs=none}. @end table -The default code model is @code{normal}. @item -mexplicit-relocs=@var{style} Set when to use assembler relocation operators when dealing with symbolic diff --git a/gcc/doc/tree-ssa.texi b/gcc/doc/tree-ssa.texi index 25aa006..670571e 100644 --- a/gcc/doc/tree-ssa.texi +++ b/gcc/doc/tree-ssa.texi @@ -383,11 +383,34 @@ under the iterators, so use the @code{FOR_EACH_IMM_USE_STMT} and sanity of the use list by moving all the uses for a statement into a controlled position, and then iterating over those uses. Then the optimization can manipulate the stmt when all the uses have been -processed. This is a little slower than the FAST version since it adds a -placeholder element and must sort through the list a bit for each statement. -This placeholder element must be also be removed if the loop is -terminated early; a destructor takes care of that when leaving the -@code{FOR_EACH_IMM_USE_STMT} scope. +processed. Only the current active @code{imm_use_p} may be altered +when using an inner @code{FOR_EACH_IMM_USE_ON_STMT} iteration. +You have to be careful to not inadvertedly modify the immediate +use list by working on another stmt than the the current @code{stmt} during +the iteration. In particular calling @code{update_stmt} is destructive +on all SSA uses immediate use lists related to the updated stmt. +This slower than the FAST version since it sorts through the list for each +statement. + +@code{FOR_EACH_IMM_USE_ON_STMT} iteration may not be nested inside +another @code{FOR_EACH_IMM_USE_ON_STMT} or @code{FOR_EACH_IMM_USE_FAST} +iteration of the same immediate use list. + +There is the @code{gather_imm_use_stmts} helper that trades memory for +removing the need to care about the immediate use list consistency and +which also avoids duplicate visiting of stmts that can occur with +@code{FOR_EACH_IMM_USE_FAST} when there are multiple uses of an SSA name +on a stmt. This can be used to iterate safely over all use stmts like +this: + +@smallexample + tree ssa_var; + + for (gimple *use_stmt : gather_imm_use_stmts (ssa_var)) + @{ + // do something with use_stmt + @} +@end smallexample There are checks in @code{verify_ssa} which verify that the immediate use list is up to date. diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ffaf520..4547b43 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,46 @@ +2025-11-05 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/122566 + * decl.cc (gfc_get_pdt_instance): Add non-PDT type exstention. + +2025-11-05 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/122501 + PR fortran/122524 + * primary.cc (gfc_convert_to_structure_constructor): Correct + whitespace issue. + (gfc_match_rvalue): Remove the attempt to match specific procs + before filling out PDT constructor. Instead, defer this until + resolution with the condition that there not be a following + arglist and more than one procedure in the generic interface. + +2025-11-05 Tobias Burnus <tburnus@baylibre.com> + + PR fortran/122570 + * openmp.cc (resolve_omp_metadirective): Fix 'skip' of + never matchable metadirective variants. + +2025-11-04 Harald Anlauf <anlauf@gmx.de> + + PR fortran/122564 + * resolve.cc (resolve_locality_spec): Delete temporary hash_set. + +2025-11-04 Paul-Antoine Arras <parras@baylibre.com> + + PR fortran/122369 + PR fortran/122508 + * gfortran.h (gfc_rebind_label): Declare new function. + * parse.cc (parse_omp_metadirective_body): Rebind labels to the outer + region. Maintain a vector of metadirective regions. + (gfc_parse_file): Initialise it. + * parse.h (GFC_PARSE_H): Declare it. + * symbol.cc (gfc_get_st_label): Look for existing labels in outer + metadirective regions. + (gfc_rebind_label): Define new function. + (gfc_define_st_label): Accept duplicate labels in metadirective body. + (gfc_reference_st_label): Accept shared DO termination labels in + metadirective body. + 2025-11-03 Steve Kargl <kargls@comcast.net> PR fortran/122513 diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index 5b222cd..96ee6bf 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -4191,30 +4191,36 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, to obtain the instance of the extended type. */ if (gfc_current_state () != COMP_DERIVED && c1 == pdt->components - && (c1->ts.type == BT_DERIVED || c1->ts.type == BT_CLASS) - && c1->ts.u.derived && c1->ts.u.derived->attr.pdt_template + && c1->ts.type == BT_DERIVED + && c1->ts.u.derived && gfc_get_derived_super_type (*sym) == c2->ts.u.derived) { - gfc_formal_arglist *f; + if (c1->ts.u.derived->attr.pdt_template) + { + gfc_formal_arglist *f; - old_param_spec_list = type_param_spec_list; + old_param_spec_list = type_param_spec_list; - /* Obtain a spec list appropriate to the extended type..*/ - actual_param = gfc_copy_actual_arglist (type_param_spec_list); - type_param_spec_list = actual_param; - for (f = c1->ts.u.derived->formal; f && f->next; f = f->next) - actual_param = actual_param->next; - if (actual_param) - { - gfc_free_actual_arglist (actual_param->next); - actual_param->next = NULL; - } + /* Obtain a spec list appropriate to the extended type..*/ + actual_param = gfc_copy_actual_arglist (type_param_spec_list); + type_param_spec_list = actual_param; + for (f = c1->ts.u.derived->formal; f && f->next; f = f->next) + actual_param = actual_param->next; + if (actual_param) + { + gfc_free_actual_arglist (actual_param->next); + actual_param->next = NULL; + } - /* Now obtain the PDT instance for the extended type. */ - c2->param_list = type_param_spec_list; - m = gfc_get_pdt_instance (type_param_spec_list, &c2->ts.u.derived, - &c2->param_list); - type_param_spec_list = old_param_spec_list; + /* Now obtain the PDT instance for the extended type. */ + c2->param_list = type_param_spec_list; + m = gfc_get_pdt_instance (type_param_spec_list, + &c2->ts.u.derived, + &c2->param_list); + type_param_spec_list = old_param_spec_list; + } + else + c2->ts = c1->ts; c2->ts.u.derived->refs++; gfc_set_sym_referenced (c2->ts.u.derived); diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 19473df..f1c4db2 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3760,6 +3760,7 @@ gfc_st_label *gfc_get_st_label (int); void gfc_free_st_label (gfc_st_label *); void gfc_define_st_label (gfc_st_label *, gfc_sl_type, locus *); bool gfc_reference_st_label (gfc_st_label *, gfc_sl_type); +gfc_st_label *gfc_rebind_label (gfc_st_label *, int); gfc_namespace *gfc_get_namespace (gfc_namespace *, int); gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *); diff --git a/gcc/fortran/openmp.cc b/gcc/fortran/openmp.cc index f5db9a8..770bc5b 100644 --- a/gcc/fortran/openmp.cc +++ b/gcc/fortran/openmp.cc @@ -12320,6 +12320,7 @@ static void resolve_omp_metadirective (gfc_code *code, gfc_namespace *ns) { gfc_omp_variant *variant = code->ext.omp_variants; + gfc_omp_variant *prev_variant = variant; while (variant) { @@ -12333,15 +12334,19 @@ resolve_omp_metadirective (gfc_code *code, gfc_namespace *ns) as the 'otherwise' clause should always match. */ if (variant == code->ext.omp_variants && !variant->next) break; - if (variant == code->ext.omp_variants) - code->ext.omp_variants = variant->next; gfc_omp_variant *tmp = variant; - variant = variant->next; + if (variant == code->ext.omp_variants) + variant = prev_variant = code->ext.omp_variants = variant->next; + else + variant = prev_variant->next = variant->next; gfc_free_omp_set_selector_list (tmp->selectors); free (tmp); } else - variant = variant->next; + { + prev_variant = variant; + variant = variant->next; + } } /* Replace metadirective by its body if only 'nothing' remains. */ if (!code->ext.omp_variants->next && code->ext.omp_variants->stmt == ST_NONE) diff --git a/gcc/fortran/parse.cc b/gcc/fortran/parse.cc index b29f690..f987f46 100644 --- a/gcc/fortran/parse.cc +++ b/gcc/fortran/parse.cc @@ -60,6 +60,7 @@ bool gfc_in_omp_metadirective_body; /* Each metadirective body in the translation unit is given a unique number, used to ensure that labels in the body have unique names. */ int gfc_omp_metadirective_region_count; +vec<int> gfc_omp_metadirective_region_stack; /* TODO: Re-order functions to kill these forward decls. */ static void check_statement_label (gfc_statement); @@ -6542,6 +6543,9 @@ parse_omp_metadirective_body (gfc_statement omp_st) gfc_in_omp_metadirective_body = true; gfc_omp_metadirective_region_count++; + gfc_omp_metadirective_region_stack.safe_push ( + gfc_omp_metadirective_region_count); + switch (variant->stmt) { case_omp_structured_block: @@ -6603,6 +6607,28 @@ parse_omp_metadirective_body (gfc_statement omp_st) *variant->code = *gfc_state_stack->head; pop_state (); + gfc_omp_metadirective_region_stack.pop (); + int outer_omp_metadirective_region + = gfc_omp_metadirective_region_stack.last (); + + /* Rebind labels in the last statement -- which is the first statement + past the end of the metadirective body -- to the outer region. */ + if (gfc_statement_label) + gfc_statement_label = gfc_rebind_label (gfc_statement_label, + outer_omp_metadirective_region); + if ((new_st.op == EXEC_READ || new_st.op == EXEC_WRITE) + && new_st.ext.dt->format_label + && new_st.ext.dt->format_label != &format_asterisk) + new_st.ext.dt->format_label + = gfc_rebind_label (new_st.ext.dt->format_label, + outer_omp_metadirective_region); + if (new_st.label1) + new_st.label1 + = gfc_rebind_label (new_st.label1, outer_omp_metadirective_region); + if (new_st.here) + new_st.here + = gfc_rebind_label (new_st.here, outer_omp_metadirective_region); + gfc_commit_symbols (); gfc_warning_check (); if (variant->next) @@ -7578,6 +7604,8 @@ gfc_parse_file (void) gfc_statement_label = NULL; gfc_omp_metadirective_region_count = 0; + gfc_omp_metadirective_region_stack.truncate (0); + gfc_omp_metadirective_region_stack.safe_push (0); gfc_in_omp_metadirective_body = false; gfc_matching_omp_context_selector = false; diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h index 7bf0fa4..70ffcbd 100644 --- a/gcc/fortran/parse.h +++ b/gcc/fortran/parse.h @@ -22,6 +22,8 @@ along with GCC; see the file COPYING3. If not see #ifndef GFC_PARSE_H #define GFC_PARSE_H +#include "vec.h" + /* Enum for what the compiler is currently doing. */ enum gfc_compile_state { @@ -76,6 +78,7 @@ extern bool gfc_matching_function; extern bool gfc_matching_omp_context_selector; extern bool gfc_in_omp_metadirective_body; extern int gfc_omp_metadirective_region_count; +extern vec<int> gfc_omp_metadirective_region_stack; match gfc_match_prefix (gfc_typespec *); bool is_oacc (gfc_state_data *); diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 1dcb1c3..496ee45 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -3543,7 +3543,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c } /* Find the current component in the structure definition and check - its access is not private. */ + its access is not private. */ if (comp) this_comp = gfc_find_component (sym, comp->name, false, false, NULL); else @@ -3836,8 +3836,6 @@ gfc_match_rvalue (gfc_expr **result) bool implicit_char; gfc_ref *ref; gfc_symtree *pdt_st; - gfc_symbol *found_specific = NULL; - m = gfc_match ("%%loc"); if (m == MATCH_YES) @@ -4085,29 +4083,21 @@ gfc_match_rvalue (gfc_expr **result) break; } - gfc_gobble_whitespace (); - found_specific = NULL; - - /* Even if 'name' is that of a PDT template, priority has to be given to - possible specific procedures in the generic interface. */ - gfc_find_sym_tree (gfc_dt_upper_string (name), NULL, 1, &pdt_st); - if (sym->generic && sym->generic->next - && gfc_peek_ascii_char() != '(') - { - gfc_actual_arglist *arg = actual_arglist; - for (; arg && pdt_st; arg = arg->next) - gfc_resolve_expr (arg->expr); - found_specific = gfc_search_interface (sym->generic, 0, - &actual_arglist); - } - /* Check to see if this is a PDT constructor. The format of these constructors is rather unusual: name [(type_params)](component_values) where, component_values excludes the type_params. With the present gfortran representation this is rather awkward because the two are not - distinguished, other than by their attributes. */ - if (sym->attr.generic && pdt_st != NULL && found_specific == NULL) + distinguished, other than by their attributes. + + Even if 'name' is that of a PDT template, priority has to be given to + specific procedures, other than the constructor, in the generic + interface. */ + + gfc_gobble_whitespace (); + gfc_find_sym_tree (gfc_dt_upper_string (name), NULL, 1, &pdt_st); + if (sym->attr.generic && pdt_st != NULL + && !(sym->generic->next && gfc_peek_ascii_char() != '(')) { gfc_symbol *pdt_sym; gfc_actual_arglist *ctr_arglist = NULL, *tmp; @@ -4172,12 +4162,8 @@ gfc_match_rvalue (gfc_expr **result) tmp = tmp->next; } - if (found_specific) - gfc_find_sym_tree (found_specific->name, - NULL, 1, &symtree); - else - gfc_find_sym_tree (gfc_dt_lower_string (pdt_sym->name), - NULL, 1, &symtree); + gfc_find_sym_tree (gfc_dt_lower_string (pdt_sym->name), + NULL, 1, &symtree); if (!symtree) { gfc_get_ha_sym_tree (gfc_dt_lower_string (pdt_sym->name) , diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 5fa408e..2a73f2a 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -8754,6 +8754,8 @@ resolve_locality_spec (gfc_code *code, gfc_namespace *ns) plist = &((*plist)->next); } } + + delete data.sym_hash; } /* Resolve a list of FORALL iterators. The FORALL index-name is constrained diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc index 8211d92..b4d3ed6 100644 --- a/gcc/fortran/symbol.cc +++ b/gcc/fortran/symbol.cc @@ -2753,8 +2753,7 @@ gfc_get_st_label (int labelno) { gfc_st_label *lp; gfc_namespace *ns; - int omp_region = (gfc_in_omp_metadirective_body - ? gfc_omp_metadirective_region_count : 0); + int omp_region = gfc_omp_metadirective_region_stack.last (); if (gfc_current_state () == COMP_DERIVED) ns = gfc_current_block ()->f2k_derived; @@ -2768,22 +2767,28 @@ gfc_get_st_label (int labelno) } /* First see if the label is already in this namespace. */ - lp = ns->st_labels; - while (lp) + gcc_checking_assert (gfc_omp_metadirective_region_stack.length () > 0); + for (int omp_region_idx = gfc_omp_metadirective_region_stack.length () - 1; + omp_region_idx >= 0; omp_region_idx--) { - if (lp->omp_region == omp_region) + int omp_region2 = gfc_omp_metadirective_region_stack[omp_region_idx]; + lp = ns->st_labels; + while (lp) { - if (lp->value == labelno) - return lp; - if (lp->value < labelno) + if (lp->omp_region == omp_region2) + { + if (lp->value == labelno) + return lp; + if (lp->value < labelno) + lp = lp->left; + else + lp = lp->right; + } + else if (lp->omp_region < omp_region2) lp = lp->left; else lp = lp->right; } - else if (lp->omp_region < omp_region) - lp = lp->left; - else - lp = lp->right; } lp = XCNEW (gfc_st_label); @@ -2799,6 +2804,53 @@ gfc_get_st_label (int labelno) return lp; } +/* Rebind a statement label to a new OpenMP region. If a label with the same + value already exists in the new region, update it and return it. Otherwise, + move the label to the new region. */ + +gfc_st_label * +gfc_rebind_label (gfc_st_label *label, int new_omp_region) +{ + gfc_st_label *lp = label->ns->st_labels; + int labelno = label->value; + + while (lp) + { + if (lp->omp_region == new_omp_region) + { + if (lp->value == labelno) + { + if (lp == label) + return label; + if (lp->defined == ST_LABEL_UNKNOWN + && label->defined != ST_LABEL_UNKNOWN) + lp->defined = label->defined; + if (lp->referenced == ST_LABEL_UNKNOWN + && label->referenced != ST_LABEL_UNKNOWN) + lp->referenced = label->referenced; + if (lp->format == NULL && label->format != NULL) + lp->format = label->format; + gfc_delete_bbt (&label->ns->st_labels, label, compare_st_labels); + return lp; + } + if (lp->value < labelno) + lp = lp->left; + else + lp = lp->right; + } + else if (lp->omp_region < new_omp_region) + lp = lp->left; + else + lp = lp->right; + } + + gfc_delete_bbt (&label->ns->st_labels, label, compare_st_labels); + label->left = nullptr; + label->right = nullptr; + label->omp_region = new_omp_region; + gfc_insert_bbt (&label->ns->st_labels, label, compare_st_labels); + return label; +} /* Called when a statement with a statement label is about to be accepted. We add the label to the list of the current namespace, @@ -2812,7 +2864,7 @@ gfc_define_st_label (gfc_st_label *lp, gfc_sl_type type, locus *label_locus) labelno = lp->value; - if (lp->defined != ST_LABEL_UNKNOWN) + if (lp->defined != ST_LABEL_UNKNOWN && !gfc_in_omp_metadirective_body) gfc_error ("Duplicate statement label %d at %L and %L", labelno, &lp->where, label_locus); else @@ -2897,6 +2949,7 @@ gfc_reference_st_label (gfc_st_label *lp, gfc_sl_type type) } if (lp->referenced == ST_LABEL_DO_TARGET && type == ST_LABEL_DO_TARGET + && !gfc_in_omp_metadirective_body && !gfc_notify_std (GFC_STD_F95_OBS | GFC_STD_F2018_DEL, "Shared DO termination label %d at %C", labelno)) return false; diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index cb40816..1bfc0ce 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -92,6 +92,8 @@ along with GCC; see the file COPYING3. If not see #include "trans-array.h" #include "trans-const.h" #include "dependency.h" +#include "cgraph.h" /* For cgraph_node::add_new_function. */ +#include "function.h" /* For push_struct_function. */ static bool gfc_get_array_constructor_size (mpz_t *, gfc_constructor_base); @@ -10022,6 +10024,125 @@ enum {DEALLOCATE_ALLOC_COMP = 1, NULLIFY_ALLOC_COMP, BCAST_ALLOC_COMP}; static gfc_actual_arglist *pdt_param_list; +static bool generating_copy_helper; + +/* Forward declaration of structure_alloc_comps for wrapper generator. */ +static tree structure_alloc_comps (gfc_symbol *, tree, tree, int, int, int, + gfc_co_subroutines_args *, bool); + +/* Generate a wrapper function that performs element-wise deep copy for + recursive allocatable array components. This wrapper is passed as a + function pointer to the runtime helper _gfortran_cfi_deep_copy_array, + allowing recursion to happen at runtime instead of compile time. */ + +static tree +get_copy_helper_function_type (void) +{ + static tree fn_type = NULL_TREE; + if (fn_type == NULL_TREE) + fn_type = build_function_type_list (void_type_node, + pvoid_type_node, + pvoid_type_node, + NULL_TREE); + return fn_type; +} + +static tree +get_copy_helper_pointer_type (void) +{ + static tree ptr_type = NULL_TREE; + if (ptr_type == NULL_TREE) + ptr_type = build_pointer_type (get_copy_helper_function_type ()); + return ptr_type; +} + +static tree +generate_element_copy_wrapper (gfc_symbol *der_type, tree comp_type, + int purpose, int caf_mode) +{ + tree fndecl, fntype, result_decl; + tree dest_parm, src_parm, dest_typed, src_typed; + tree der_type_ptr; + stmtblock_t block; + tree decls; + tree body; + + fntype = get_copy_helper_function_type (); + + fndecl = build_decl (input_location, FUNCTION_DECL, + create_tmp_var_name ("copy_element"), + fntype); + + TREE_STATIC (fndecl) = 1; + TREE_USED (fndecl) = 1; + DECL_ARTIFICIAL (fndecl) = 1; + DECL_IGNORED_P (fndecl) = 0; + TREE_PUBLIC (fndecl) = 0; + DECL_UNINLINABLE (fndecl) = 1; + DECL_EXTERNAL (fndecl) = 0; + DECL_CONTEXT (fndecl) = NULL_TREE; + DECL_INITIAL (fndecl) = make_node (BLOCK); + BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl; + + result_decl = build_decl (input_location, RESULT_DECL, NULL_TREE, + void_type_node); + DECL_ARTIFICIAL (result_decl) = 1; + DECL_IGNORED_P (result_decl) = 1; + DECL_CONTEXT (result_decl) = fndecl; + DECL_RESULT (fndecl) = result_decl; + + dest_parm = build_decl (input_location, PARM_DECL, + get_identifier ("dest"), pvoid_type_node); + src_parm = build_decl (input_location, PARM_DECL, + get_identifier ("src"), pvoid_type_node); + + DECL_ARTIFICIAL (dest_parm) = 1; + DECL_ARTIFICIAL (src_parm) = 1; + DECL_ARG_TYPE (dest_parm) = pvoid_type_node; + DECL_ARG_TYPE (src_parm) = pvoid_type_node; + DECL_CONTEXT (dest_parm) = fndecl; + DECL_CONTEXT (src_parm) = fndecl; + + DECL_ARGUMENTS (fndecl) = dest_parm; + TREE_CHAIN (dest_parm) = src_parm; + + push_struct_function (fndecl); + cfun->function_end_locus = input_location; + + pushlevel (); + gfc_init_block (&block); + + bool saved_generating = generating_copy_helper; + generating_copy_helper = true; + + der_type_ptr = build_pointer_type (comp_type); + dest_typed = fold_convert (der_type_ptr, dest_parm); + src_typed = fold_convert (der_type_ptr, src_parm); + + dest_typed = build_fold_indirect_ref (dest_typed); + src_typed = build_fold_indirect_ref (src_typed); + + body = structure_alloc_comps (der_type, src_typed, dest_typed, + 0, purpose, caf_mode, NULL, false); + gfc_add_expr_to_block (&block, body); + + generating_copy_helper = saved_generating; + + body = gfc_finish_block (&block); + decls = getdecls (); + + poplevel (1, 1); + + DECL_SAVED_TREE (fndecl) + = fold_build3_loc (DECL_SOURCE_LOCATION (fndecl), BIND_EXPR, + void_type_node, decls, body, DECL_INITIAL (fndecl)); + + pop_cfun (); + + cgraph_node::add_new_function (fndecl, false); + + return build1 (ADDR_EXPR, get_copy_helper_pointer_type (), fndecl); +} static tree structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest, @@ -10186,6 +10307,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest, && seen_derived_types.contains (c->ts.u.derived)) || (c->ts.type == BT_CLASS && seen_derived_types.contains (CLASS_DATA (c)->ts.u.derived)); + bool inside_wrapper = generating_copy_helper; bool is_pdt_type = c->ts.type == BT_DERIVED && c->ts.u.derived->attr.pdt_type; @@ -10862,9 +10984,57 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest, false, false, NULL_TREE, NULL_TREE); gfc_add_expr_to_block (&fnblock, tmp); } + /* Special case: recursive allocatable array components require runtime + helper to avoid compile-time infinite recursion. Generate a call to + _gfortran_cfi_deep_copy_array with an element copy wrapper. */ + else if (c->attr.allocatable && c->as && cmp_has_alloc_comps && same_type + && purpose == COPY_ALLOC_COMP && !c->attr.proc_pointer + && !c->attr.codimension && !caf_in_coarray (caf_mode) + && c->ts.type == BT_DERIVED && c->ts.u.derived != NULL) + { + tree copy_wrapper, call, dest_addr, src_addr, elem_type; + tree helper_ptr_type; + tree alloc_expr; + int comp_rank; + + /* Get the element type from ctype (which is already the component type). + For arrays, we need the element type, not the array type. */ + elem_type = ctype; + if (GFC_DESCRIPTOR_TYPE_P (ctype)) + elem_type = gfc_get_element_type (ctype); + else if (TREE_CODE (ctype) == ARRAY_TYPE) + elem_type = TREE_TYPE (ctype); + + helper_ptr_type = get_copy_helper_pointer_type (); + + comp_rank = c->as ? c->as->rank : 0; + alloc_expr = gfc_duplicate_allocatable_nocopy (dcmp, comp, ctype, + comp_rank); + gfc_add_expr_to_block (&fnblock, alloc_expr); + + /* Generate or reuse the element copy helper. Inside an existing helper + we can reuse the current function to prevent recursive generation. */ + if (inside_wrapper) + copy_wrapper = gfc_build_addr_expr (NULL_TREE, current_function_decl); + else + copy_wrapper = generate_element_copy_wrapper (c->ts.u.derived, + elem_type, + purpose, caf_mode); + copy_wrapper = fold_convert (helper_ptr_type, copy_wrapper); + + /* Build addresses of descriptors. */ + dest_addr = gfc_build_addr_expr (pvoid_type_node, dcmp); + src_addr = gfc_build_addr_expr (pvoid_type_node, comp); + + /* Build call: _gfortran_cfi_deep_copy_array (&dcmp, &comp, wrapper). */ + call = build_call_expr_loc (input_location, + gfor_fndecl_cfi_deep_copy_array, 3, + dest_addr, src_addr, copy_wrapper); + gfc_add_expr_to_block (&fnblock, call); + } else if (c->attr.allocatable && !c->attr.proc_pointer - && (!(cmp_has_alloc_comps && c->as) || c->attr.codimension - || caf_in_coarray (caf_mode))) + && (add_when_allocated != NULL_TREE || !cmp_has_alloc_comps || !c->as + || c->attr.codimension || caf_in_coarray (caf_mode))) { rank = c->as ? c->as->rank : 0; if (c->attr.codimension) diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index c31c756..419de2c 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -248,6 +248,9 @@ tree gfor_fndecl_zgemm; /* RANDOM_INIT function. */ tree gfor_fndecl_random_init; /* libgfortran, 1 image only. */ +/* Deep copy helper for recursive allocatable array components. */ +tree gfor_fndecl_cfi_deep_copy_array; + static void gfc_add_decl_to_parent_function (tree decl) { @@ -3588,6 +3591,23 @@ gfc_build_intrinsic_function_decls (void) gfc_charlen_type_node, pchar1_type_node, gfc_charlen_type_node, gfc_logical4_type_node); + { + tree copy_helper_ptr_type; + tree copy_helper_fn_type; + + copy_helper_fn_type = build_function_type_list (void_type_node, + pvoid_type_node, + pvoid_type_node, + NULL_TREE); + copy_helper_ptr_type = build_pointer_type (copy_helper_fn_type); + + gfor_fndecl_cfi_deep_copy_array + = gfc_build_library_function_decl_with_spec ( + get_identifier (PREFIX ("cfi_deep_copy_array")), ". R R . ", + void_type_node, 3, pvoid_type_node, pvoid_type_node, + copy_helper_ptr_type); + } + gfor_fndecl_adjustl = gfc_build_library_function_decl_with_spec ( get_identifier (PREFIX("adjustl")), ". W . R ", void_type_node, 3, pchar1_type_node, gfc_charlen_type_node, diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index 5b9111d3..289a366 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -12559,10 +12559,23 @@ conv_intrinsic_atomic_op (gfc_code *code) else image_index = integer_zero_node; - if (!POINTER_TYPE_P (TREE_TYPE (value))) + /* Create a temporary if value is not already a pointer, or if it's an + address of a constant (which is invalid in C). */ + bool need_tmp = !POINTER_TYPE_P (TREE_TYPE (value)); + if (POINTER_TYPE_P (TREE_TYPE (value)) + && TREE_CODE (value) == ADDR_EXPR + && TREE_CONSTANT (TREE_OPERAND (value, 0))) + need_tmp = true; + + if (need_tmp) { tmp = gfc_create_var (TREE_TYPE (TREE_TYPE (atom)), "value"); - gfc_add_modify (&block, tmp, fold_convert (TREE_TYPE (tmp), value)); + if (POINTER_TYPE_P (TREE_TYPE (value))) + gfc_add_modify (&block, tmp, + fold_convert (TREE_TYPE (tmp), + build_fold_indirect_ref (value))); + else + gfc_add_modify (&block, tmp, fold_convert (TREE_TYPE (tmp), value)); value = gfc_build_addr_expr (NULL_TREE, tmp); } diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 1d04b22..6a465f4 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -1004,6 +1004,9 @@ extern GTY(()) tree gfor_fndecl_ieee_procedure_exit; extern GTY(()) tree gfor_fndecl_random_init; extern GTY(()) tree gfor_fndecl_caf_random_init; +/* Deep copy helper for recursive allocatable array components. */ +extern GTY(()) tree gfor_fndecl_cfi_deep_copy_array; + /* True if node is an integer constant. */ #define INTEGER_CST_P(node) (TREE_CODE(node) == INTEGER_CST) diff --git a/gcc/gimple-ssa-isolate-paths.cc b/gcc/gimple-ssa-isolate-paths.cc index ca1daf1..ffa04d1 100644 --- a/gcc/gimple-ssa-isolate-paths.cc +++ b/gcc/gimple-ssa-isolate-paths.cc @@ -56,7 +56,7 @@ check_loadstore (gimple *stmt, tree op, tree, void *data) { TREE_THIS_VOLATILE (op) = 1; TREE_SIDE_EFFECTS (op) = 1; - update_stmt (stmt); + gimple_set_has_volatile_ops (stmt, true); return true; } return false; @@ -762,6 +762,7 @@ find_implicit_erroneous_behavior (void) /* We've got a NULL PHI argument. Now see if the PHI's result is dereferenced within BB. */ + auto_vec <gimple *, 4> uses_in_bb; FOR_EACH_IMM_USE_STMT (use_stmt, iter, lhs) { /* We only care about uses in BB. Catching cases in @@ -774,18 +775,23 @@ find_implicit_erroneous_behavior (void) ? gimple_location (use_stmt) : phi_arg_loc; - if (stmt_uses_name_in_undefined_way (use_stmt, lhs, loc) - && (duplicate || can_duplicate_block_p (bb))) + if (stmt_uses_name_in_undefined_way (use_stmt, lhs, loc)) { - duplicate = isolate_path (bb, duplicate, e, - use_stmt, lhs, false); - - /* When we remove an incoming edge, we need to - reprocess the Ith element. */ - next_i = i; - cfg_altered = true; + if (!can_duplicate_block_p (bb)) + break; + uses_in_bb.safe_push (use_stmt); } } + for (gimple *use_stmt : uses_in_bb) + { + duplicate = isolate_path (bb, duplicate, e, + use_stmt, lhs, false); + + /* When we remove an incoming edge, we need to + reprocess the Ith element. */ + next_i = i; + cfg_altered = true; + } } } } diff --git a/gcc/gimple.h b/gcc/gimple.h index 0356bc5..9bd3f8c 100644 --- a/gcc/gimple.h +++ b/gcc/gimple.h @@ -250,8 +250,8 @@ struct GTY((desc ("gimple_statement_structure (&%h)"), tag ("GSS_BASE"), /* Nonzero if this statement contains volatile operands. */ unsigned has_volatile_ops : 1; - /* Padding to get subcode to 16 bit alignment. */ - unsigned pad : 1; + /* Infrastructure local flag. Always clear. */ + unsigned ilf : 1; /* The SUBCODE field can be used for tuple-specific flags for tuples that do not require subcodes. Note that SUBCODE should be at diff --git a/gcc/lto-wrapper.cc b/gcc/lto-wrapper.cc index dbe3ad0..ae63dbb 100644 --- a/gcc/lto-wrapper.cc +++ b/gcc/lto-wrapper.cc @@ -1214,18 +1214,16 @@ debug_objcopy (const char *infile, bool rename) const char *p; const char *orig_infile = infile; - off_t inoff = 0; - long loffset; + int64_t inoff = 0; int consumed; if ((p = strrchr (infile, '@')) && p != infile - && sscanf (p, "@%li%n", &loffset, &consumed) >= 1 + && sscanf (p, "@%" PRIi64 "%n", &inoff, &consumed) >= 1 && strlen (p) == (unsigned int) consumed) { char *fname = xstrdup (infile); fname[p - infile] = '\0'; infile = fname; - inoff = (off_t) loffset; } int infd = open (infile, O_RDONLY | O_BINARY); if (infd == -1) @@ -1491,8 +1489,7 @@ run_gcc (unsigned argc, char *argv[]) { char *p; int fd; - off_t file_offset = 0; - long loffset; + int64_t file_offset = 0; int consumed; char *filename = argv[i]; @@ -1506,13 +1503,12 @@ run_gcc (unsigned argc, char *argv[]) if ((p = strrchr (argv[i], '@')) && p != argv[i] - && sscanf (p, "@%li%n", &loffset, &consumed) >= 1 + && sscanf (p, "@%" PRIi64 "%n", &file_offset, &consumed) >= 1 && strlen (p) == (unsigned int) consumed) { filename = XNEWVEC (char, p - argv[i] + 1); memcpy (filename, argv[i], p - argv[i]); filename[p - argv[i]] = '\0'; - file_offset = (off_t) loffset; } fd = open (filename, O_RDONLY | O_BINARY); /* Linker plugin passes -fresolution and -flinker-output options. @@ -1809,20 +1805,18 @@ cont1: for (i = 0; i < num_offload_files; i++) { char *p; - long loffset; int fd, consumed; - off_t file_offset = 0; + int64_t file_offset = 0; char *filename = offload_argv[i]; if ((p = strrchr (offload_argv[i], '@')) && p != offload_argv[i] - && sscanf (p, "@%li%n", &loffset, &consumed) >= 1 + && sscanf (p, "@%" PRIi64 "%n", &file_offset, &consumed) >= 1 && strlen (p) == (unsigned int) consumed) { filename = XNEWVEC (char, p - offload_argv[i] + 1); memcpy (filename, offload_argv[i], p - offload_argv[i]); filename[p - offload_argv[i]] = '\0'; - file_offset = (off_t) loffset; } fd = open (filename, O_RDONLY | O_BINARY); if (fd == -1) diff --git a/gcc/lto/ChangeLog b/gcc/lto/ChangeLog index c059e06..c3c37f6 100644 --- a/gcc/lto/ChangeLog +++ b/gcc/lto/ChangeLog @@ -1,3 +1,11 @@ +2025-11-04 Siddhesh Poyarekar <siddhesh@gotplt.org> + + PR lto/122515 + * lto.h (lto_section_slot): Set type of START to off_t. + * lto-common.cc (lto_read_section_data): Adjust. + * lto-object.cc (lto_obj_file_open): Set type of OFFSET to + int64_t. + 2025-10-30 Michal Jires <mjires@suse.cz> * lto.cc (stream_out_partitions): Remove asm_nodes_out. diff --git a/gcc/lto/lto-common.cc b/gcc/lto/lto-common.cc index 6463120..3d35c03 100644 --- a/gcc/lto/lto-common.cc +++ b/gcc/lto/lto-common.cc @@ -2395,15 +2395,15 @@ static size_t page_mask; static char * lto_read_section_data (struct lto_file_decl_data *file_data, - intptr_t offset, size_t len) + off_t offset, size_t len) { char *result; static int fd = -1; static char *fd_name; #if LTO_MMAP_IO - intptr_t computed_len; - intptr_t computed_offset; - intptr_t diff; + size_t computed_len; + off_t computed_offset; + off_t diff; #endif /* Keep a single-entry file-descriptor cache. The last file we @@ -2436,9 +2436,15 @@ lto_read_section_data (struct lto_file_decl_data *file_data, page_mask = ~(page_size - 1); } - computed_offset = offset & page_mask; + computed_offset = offset & ((off_t) page_mask); diff = offset - computed_offset; - computed_len = len + diff; + if (len > (size_t) (SSIZE_MAX - diff)) + { + fatal_error (input_location, "Cannot map %s: section is too long", + file_data->file_name); + return NULL; + } + computed_len = (size_t) diff + len; result = (char *) mmap (NULL, computed_len, PROT_READ, MAP_PRIVATE, fd, computed_offset); diff --git a/gcc/lto/lto-object.cc b/gcc/lto/lto-object.cc index 6f6d55b..1fad652 100644 --- a/gcc/lto/lto-object.cc +++ b/gcc/lto/lto-object.cc @@ -69,10 +69,9 @@ lto_file * lto_obj_file_open (const char *filename, bool writable) { const char *offset_p; - long loffset; int consumed; char *fname; - off_t offset; + int64_t offset; struct lto_simple_object *lo; const char *errmsg; int err; @@ -80,13 +79,12 @@ lto_obj_file_open (const char *filename, bool writable) offset_p = strrchr (filename, '@'); if (offset_p != NULL && offset_p != filename - && sscanf (offset_p, "@%li%n", &loffset, &consumed) >= 1 + && sscanf (offset_p, "@%" PRIi64 "%n", &offset, &consumed) >= 1 && strlen (offset_p) == (unsigned int) consumed) { fname = XNEWVEC (char, offset_p - filename + 1); memcpy (fname, filename, offset_p - filename); fname[offset_p - filename] = '\0'; - offset = (off_t) loffset; } else { diff --git a/gcc/lto/lto.h b/gcc/lto/lto.h index e649959..a619a43 100644 --- a/gcc/lto/lto.h +++ b/gcc/lto/lto.h @@ -58,7 +58,7 @@ extern int lto_link_dump_id, decl_merge_dump_id, partition_dump_id; struct lto_section_slot { const char *name; - intptr_t start; + off_t start; size_t len; struct lto_section_slot *next; }; diff --git a/gcc/match.pd b/gcc/match.pd index 6aaf80e..0ea86d9 100644 --- a/gcc/match.pd +++ b/gcc/match.pd @@ -3656,34 +3656,39 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) /* Saturation mult for unsigned integer. */ (if (INTEGRAL_TYPE_P (type) && TYPE_UNSIGNED (type)) (for mult_op (mult widen_mult) - (match (unsigned_integer_sat_mul @0 @1) - /* SAT_U_MUL (X, Y) = { - WT x = (WT)a * (WT)b; - T max = -1; - if (x > (WT)(max)) - return max; - else - return (T)x; + (match (usmul_widen_mult @0 @1) + (mult_op:c (convert@2 @0) (convert @1)) + (if (types_match (@0, @1) && TYPE_UNSIGNED (TREE_TYPE (@0))) + (with + { + unsigned prec = TYPE_PRECISION (TREE_TYPE (@0)); + unsigned cvt2_prec = TYPE_PRECISION (TREE_TYPE (@2)); + bool widen_cvt_p = cvt2_prec > prec; } - while WT is uint128_t, T is uint8_t, uint16_t, uint32_t or uint64_t. */ - (convert (min (mult_op:c@3 (convert@4 @0) (convert@5 @1)) INTEGER_CST@2)) - (if (types_match (type, @0, @1)) - (with - { + (if (widen_cvt_p)))))) + (match (usmul_widen_mult @0 @1) + (widen_mult:c @0 @1) + (if (types_match (@0, @1)))) + (match (unsigned_integer_sat_mul @0 @1) + /* SAT_U_MUL (X, Y) = { + WT x = (WT)a * (WT)b; + T max = -1; + if (x > (WT)(max)) + return max; + else + return (T)x; + } + while WT is uint128_t, T is uint8_t, uint16_t, uint32_t or uint64_t. */ + (convert (min (usmul_widen_mult@3 @0 @1) INTEGER_CST@2)) + (if (types_match (type, @0, @1)) + (with + { unsigned prec = TYPE_PRECISION (type); unsigned widen_prec = TYPE_PRECISION (TREE_TYPE (@3)); - unsigned cvt4_prec = TYPE_PRECISION (TREE_TYPE (@4)); - unsigned cvt5_prec = TYPE_PRECISION (TREE_TYPE (@5)); - wide_int max = wi::mask (prec, false, widen_prec); bool c2_is_max_p = wi::eq_p (wi::to_wide (@2), max); - - bool widen_mult_p = mult_op == WIDEN_MULT_EXPR && cvt4_prec == cvt5_prec - && widen_prec == cvt5_prec * 2 && widen_prec > prec; - bool mult_p = mult_op == MULT_EXPR && cvt4_prec == cvt5_prec - && cvt4_prec == widen_prec && widen_prec > prec; - } - (if (c2_is_max_p && (widen_mult_p || mult_p))))))) + } + (if (c2_is_max_p))))) (match (unsigned_integer_sat_mul @0 @1) /* SAT_U_MUL (X, Y) = { T result; @@ -3751,19 +3756,6 @@ DEFINE_INT_AND_FLOAT_ROUND_FN (RINT) bool c2_is_type_precision_p = tree_to_uhwi (@2) == prec; } (if (c2_is_type_precision_p && (mult_p || widen_mult_p))))))) - (match (unsigned_integer_sat_mul @0 @1) - (convert (min (widen_mult:c@3 @0 @1) INTEGER_CST@2)) - (if (types_match (type, @0, @1)) - (with - { - unsigned prec = TYPE_PRECISION (type); - unsigned widen_prec = TYPE_PRECISION (TREE_TYPE (@3)); - - wide_int max = wi::mask (prec, false, widen_prec); - bool c2_is_max_p = wi::eq_p (wi::to_wide (@2), max); - bool widen_mult_p = prec * 2 == widen_prec; - } - (if (c2_is_max_p && widen_mult_p))))) (match (unsigned_integer_sat_mul @0 @1) (convert1? (bit_ior diff --git a/gcc/range-op-mixed.h b/gcc/range-op-mixed.h index db31c2b..f79cac8 100644 --- a/gcc/range-op-mixed.h +++ b/gcc/range-op-mixed.h @@ -803,35 +803,6 @@ public: { return range_compatible_p (t1, t2) && range_compatible_p (t1, t3); } }; -class operator_bitwise_xor : public range_operator -{ -public: - using range_operator::op1_range; - using range_operator::op2_range; - using range_operator::op1_op2_relation_effect; - using range_operator::update_bitmask; - bool op1_range (irange &r, tree type, - const irange &lhs, const irange &op2, - relation_trio rel = TRIO_VARYING) const final override; - bool op2_range (irange &r, tree type, - const irange &lhs, const irange &op1, - relation_trio rel = TRIO_VARYING) const final override; - bool op1_op2_relation_effect (irange &lhs_range, - tree type, - const irange &op1_range, - const irange &op2_range, - relation_kind rel) const final override; - void update_bitmask (irange &r, const irange &lh, - const irange &rh) const final override; - // Check compatibility of all operands. - bool operand_check_p (tree t1, tree t2, tree t3) const final override - { return range_compatible_p (t1, t2) && range_compatible_p (t1, t3); } -private: - void wi_fold (irange &r, tree type, const wide_int &lh_lb, - const wide_int &lh_ub, const wide_int &rh_lb, - const wide_int &rh_ub) const final override; -}; - class operator_bitwise_and : public range_operator { public: @@ -896,6 +867,43 @@ protected: const wide_int &rh_ub) const override; }; +class operator_bitwise_xor : public range_operator +{ +public: + using range_operator::fold_range; + using range_operator::op1_range; + using range_operator::op2_range; + using range_operator::op1_op2_relation_effect; + using range_operator::update_bitmask; + bool fold_range (irange &r, tree type, + const irange &lh, const irange &rh, + relation_trio rel = TRIO_VARYING) const final override; + bool op1_range (irange &r, tree type, + const irange &lhs, const irange &op2, + relation_trio rel = TRIO_VARYING) const final override; + bool op2_range (irange &r, tree type, + const irange &lhs, const irange &op1, + relation_trio rel = TRIO_VARYING) const final override; + bool op1_op2_relation_effect (irange &lhs_range, + tree type, + const irange &op1_range, + const irange &op2_range, + relation_kind rel) const final override; + void update_bitmask (irange &r, const irange &lh, + const irange &rh) const final override; + // Check compatibility of all operands. + bool operand_check_p (tree t1, tree t2, tree t3) const final override + { return range_compatible_p (t1, t2) && range_compatible_p (t1, t3); } +private: + void wi_fold (irange &r, tree type, const wide_int &lh_lb, + const wide_int &lh_ub, const wide_int &rh_lb, + const wide_int &rh_ub) const final override; + class operator_bitwise_and m_and; + class operator_bitwise_or m_or; + class operator_bitwise_not m_not; +}; + + class operator_min : public range_operator { public: diff --git a/gcc/range-op.cc b/gcc/range-op.cc index cf5b8fe..82a994b 100644 --- a/gcc/range-op.cc +++ b/gcc/range-op.cc @@ -4046,6 +4046,83 @@ operator_bitwise_xor::update_bitmask (irange &r, const irange &lh, update_known_bitmask (r, BIT_XOR_EXPR, lh, rh); } +bool +operator_bitwise_xor::fold_range (irange &r, tree type, + const irange &lh, const irange &rh, + relation_trio rel) const +{ + // Handle X ^ UNDEFINED = UNDEFINED. + if (lh.undefined_p () || rh.undefined_p ()) + { + r.set_undefined (); + return true; + } + + // Next, handle X ^ X == [0, 0]. + if (rel.op1_op2 () == VREL_EQ) + { + r.set_zero (type); + return true; + } + + // If either operand is VARYING, the result is VARYING. + if (lh.varying_p () || rh.varying_p ()) + { + // If the operands are not equal, zero is not possible. + if (rel.op1_op2 () != VREL_NE) + r.set_varying (type); + else + r.set_nonzero (type); + return true; + } + + // Now deal with X ^ 0 == X. + if (lh.zero_p ()) + { + r = rh; + return true; + } + if (rh.zero_p ()) + { + r = lh; + return true; + } + + // Start with the legacy range. This can sometimes pick up values + // when there are a lot of subranges and fold_range aggregates them. + bool res = range_operator::fold_range (r, type, lh, rh, rel); + + // Calculate the XOR identity : x ^ y = (x | y) & ~(x & y) + // AND and OR are already much better optimized. + int_range_max tmp1, tmp2, tmp3, new_result; + int_range<2> varying; + varying.set_varying (type); + + if (m_or.fold_range (tmp1, type, lh, rh, rel) + && m_and.fold_range (tmp2, type, lh, rh, rel) + && m_not.fold_range (tmp3, type, tmp2, varying, rel) + && m_and.fold_range (new_result, type, tmp1, tmp3, rel)) + { + // If the operands are not equal, or the LH does not contain any + // element of the RH, zero is not possible. + tmp1 = lh; + if (rel.op1_op2 () == VREL_NE + || (tmp1.intersect (rh) && tmp1.undefined_p ())) + { + tmp1.set_nonzero (type); + new_result.intersect (tmp1); + } + + // Combine with the legacy range if there was one. + if (res) + r.intersect (new_result); + else + r = new_result; + return true; + } + return res; +} + void operator_bitwise_xor::wi_fold (irange &r, tree type, const wide_int &lh_lb, diff --git a/gcc/simplify-rtx.cc b/gcc/simplify-rtx.cc index 53592d2..59a86c6 100644 --- a/gcc/simplify-rtx.cc +++ b/gcc/simplify-rtx.cc @@ -4184,6 +4184,46 @@ simplify_context::simplify_binary_operation_1 (rtx_code code, not do an AND. */ if ((nzop0 & ~val1) == 0) return op0; + + /* Canonicalize (and (subreg (lshiftrt X shift)) mask) into + (and (lshiftrt (subreg X) shift) mask). + + Keeps shift and AND in the same mode, improving recognition. + Only applied when subreg is a lowpart, shift is valid, + and no precision is lost. */ + if (SUBREG_P (op0) && subreg_lowpart_p (op0) + && GET_CODE (XEXP (op0, 0)) == LSHIFTRT + && CONST_INT_P (XEXP (XEXP (op0, 0), 1)) + && INTVAL (XEXP (XEXP (op0, 0), 1)) >= 0 + && INTVAL (XEXP (XEXP (op0, 0), 1)) < HOST_BITS_PER_WIDE_INT + && ((INTVAL (XEXP (XEXP (op0, 0), 1)) + + floor_log2 (val1)) + < GET_MODE_PRECISION (as_a <scalar_int_mode> (mode)))) + { + tem = XEXP (XEXP (op0, 0), 0); + if (SUBREG_P (tem)) + { + if (subreg_lowpart_p (tem)) + tem = SUBREG_REG (tem); + else + tem = NULL_RTX; + } + if (tem != NULL_RTX) + { + offset = subreg_lowpart_offset (mode, GET_MODE (tem)); + tem = simplify_gen_subreg (mode, tem, GET_MODE (tem), + offset); + if (tem) + { + unsigned shiftamt = INTVAL (XEXP (XEXP (op0, 0), 1)); + rtx shiftamtrtx = gen_int_shift_amount (mode, + shiftamt); + op0 = simplify_gen_binary (LSHIFTRT, mode, tem, + shiftamtrtx); + return simplify_gen_binary (AND, mode, op0, op1); + } + } + } } nzop1 = nonzero_bits (trueop1, mode); /* If we are clearing all the nonzero bits, the result is zero. */ diff --git a/gcc/ssa-iterators.h b/gcc/ssa-iterators.h index 0822a98..24cf6bf 100644 --- a/gcc/ssa-iterators.h +++ b/gcc/ssa-iterators.h @@ -42,10 +42,10 @@ along with GCC; see the file COPYING3. If not see Safe iteration via FOR_EACH_IMM_USE_STMT and FOR_EACH_IMM_USE_ON_STMT allows insertion, deletion, and modification of SSA operands within the current stmt iterated. The iterator manages this by re-sorting - the immediate uses to batch uses on a single stmt after each other - and inserts a marker node into the list immediately after the node - ending the current batch. This marker node is uniquely identified by - having null stmt *and* a null use pointer. */ + the immediate uses to batch uses on a single stmt after each other. + If using an inner FOR_EACH_IMM_USE_ON_STMT iteration only the active + use may be manipulated. Safety relies on new immediate uses being + inserted at the front of immediate use lists. */ struct imm_use_iterator { @@ -53,21 +53,46 @@ struct imm_use_iterator ssa_use_operand_t *imm_use; /* This marks the last use in the list (use node from SSA_NAME) */ ssa_use_operand_t *end_p; - /* This node is inserted and used to mark the end of the uses for a stmt. */ - ssa_use_operand_t iter_node; + /* This is the next ssa_name to visit in an outer FOR_EACH_IMM_USE_STMT. + Also used for fast imm use iterator checking. */ + ssa_use_operand_t *next_stmt_use; /* This is the next ssa_name to visit. IMM_USE may get removed before the next one is traversed to, so it must be cached early. */ ssa_use_operand_t *next_imm_name; + /* This is the SSA name iterated over. */ + tree name; }; /* Use this iterator when simply looking at stmts. Adding, deleting or modifying stmts will cause this iterator to malfunction. */ +#if ! defined ENABLE_GIMPLE_CHECKING #define FOR_EACH_IMM_USE_FAST(DEST, ITER, SSAVAR) \ for ((DEST) = first_readonly_imm_use (&(ITER), (SSAVAR)); \ !end_readonly_imm_use_p (&(ITER)); \ (void) ((DEST) = next_readonly_imm_use (&(ITER)))) +#else + +/* arrange to automatically call, upon descruction, with a given pointer + to imm_use_iterator. */ +struct auto_end_imm_use_fast_traverse +{ + imm_use_iterator *imm; + auto_end_imm_use_fast_traverse (imm_use_iterator *imm) + : imm (imm) {} + ~auto_end_imm_use_fast_traverse () + { imm->name->ssa_name.fast_iteration_depth--; } +}; + +#define FOR_EACH_IMM_USE_FAST(DEST, ITER, SSAVAR) \ + for (struct auto_end_imm_use_fast_traverse \ + auto_end_imm_use_fast_traverse \ + ((((DEST) = first_readonly_imm_use (&(ITER), (SSAVAR))), \ + &(ITER))); \ + !end_readonly_imm_use_p (&(ITER)); \ + (void) ((DEST) = next_readonly_imm_use (&(ITER)))) +#endif /* Forward declare for use in the class below. */ inline void end_imm_use_stmt_traverse (imm_use_iterator *); @@ -114,6 +139,11 @@ struct auto_end_imm_use_stmt_traverse (void) ((DEST) = next_imm_use_on_stmt (&(ITER)))) +/* Use this to get a vector of all gimple stmts using SSAVAR without + duplicates. It's cheaper than FOR_EACH_IMM_USE_STMT and has no + constraints on what you are allowed to do inside an iteration + over the vector. */ +extern auto_vec<gimple *, 2> gather_imm_use_stmts (tree ssavar); extern bool single_imm_use_1 (const ssa_use_operand_t *head, use_operand_p *use_p, gimple **stmt); @@ -245,6 +275,20 @@ delink_imm_use (ssa_use_operand_t *linknode) if (linknode->prev == NULL) return; +#if defined ENABLE_GIMPLE_CHECKING + if (linknode->loc.stmt + /* update_stmt on constant/removed uses. */ + && USE_FROM_PTR (linknode) + && TREE_CODE (USE_FROM_PTR (linknode)) == SSA_NAME) + { + tree var = USE_FROM_PTR (linknode); + gcc_assert (var->ssa_name.fast_iteration_depth == 0 + && (var->ssa_name.active_iterated_stmt == NULL + || (var->ssa_name.active_iterated_stmt + == linknode->loc.stmt))); + } +#endif + linknode->prev->next = linknode->next; linknode->next->prev = linknode->prev; linknode->prev = NULL; @@ -343,9 +387,13 @@ end_readonly_imm_use_p (const imm_use_iterator *imm) inline use_operand_p first_readonly_imm_use (imm_use_iterator *imm, tree var) { +#if defined ENABLE_GIMPLE_CHECKING + var->ssa_name.fast_iteration_depth++; +#endif imm->end_p = &(SSA_NAME_IMM_USE_NODE (var)); imm->imm_use = imm->end_p->next; - imm->iter_node.next = imm->imm_use->next; + imm->next_stmt_use = imm->imm_use->next; + imm->name = var; if (end_readonly_imm_use_p (imm)) return NULL_USE_OPERAND_P; return imm->imm_use; @@ -363,8 +411,8 @@ next_readonly_imm_use (imm_use_iterator *imm) using the SAFE version of the iterator. */ if (flag_checking) { - gcc_assert (imm->iter_node.next == old->next); - imm->iter_node.next = old->next->next; + gcc_assert (imm->next_stmt_use == old->next); + imm->next_stmt_use = old->next->next; } imm->imm_use = old->next; @@ -840,9 +888,11 @@ end_imm_use_stmt_p (const imm_use_iterator *imm) placeholder node from the list. */ inline void -end_imm_use_stmt_traverse (imm_use_iterator *imm) +end_imm_use_stmt_traverse (imm_use_iterator * ARG_UNUSED (imm)) { - delink_imm_use (&(imm->iter_node)); +#if defined ENABLE_GIMPLE_CHECKING + imm->name->ssa_name.active_iterated_stmt = NULL; +#endif } /* Immediate use traversal of uses within a stmt require that all the @@ -875,10 +925,11 @@ move_use_after_head (use_operand_p use_p, use_operand_p head, /* This routine will relink all uses with the same stmt as HEAD into the list - immediately following HEAD for iterator IMM. */ + immediately following HEAD for iterator IMM and returns the last use on + that stmt. */ -inline void -link_use_stmts_after (use_operand_p head, imm_use_iterator *imm) +inline use_operand_p +link_use_stmts_after (use_operand_p head, imm_use_iterator *) { use_operand_p use_p; use_operand_p last_p = head; @@ -910,33 +961,34 @@ link_use_stmts_after (use_operand_p head, imm_use_iterator *imm) last_p = move_use_after_head (use_p, head, last_p); } } - /* Link iter node in after last_p. */ - if (imm->iter_node.prev != NULL) - delink_imm_use (&imm->iter_node); - link_imm_use_to_list (&(imm->iter_node), last_p); + return last_p; } /* Initialize IMM to traverse over uses of VAR. Return the first statement. */ inline gimple * first_imm_use_stmt (imm_use_iterator *imm, tree var) { +#if defined ENABLE_GIMPLE_CHECKING + gcc_assert (var->ssa_name.active_iterated_stmt == NULL + && var->ssa_name.fast_iteration_depth == 0); +#endif imm->end_p = &(SSA_NAME_IMM_USE_NODE (var)); imm->imm_use = imm->end_p->next; imm->next_imm_name = NULL_USE_OPERAND_P; - /* iter_node is used as a marker within the immediate use list to indicate - where the end of the current stmt's uses are. Initialize it to NULL - stmt and use, which indicates a marker node. */ - imm->iter_node.prev = NULL_USE_OPERAND_P; - imm->iter_node.next = NULL_USE_OPERAND_P; - imm->iter_node.loc.stmt = NULL; - imm->iter_node.use = NULL; + /* next_stmt_use is used to point to the immediate use node after + the set of uses for the current stmt. */ + imm->next_stmt_use = NULL_USE_OPERAND_P; + imm->name = var; if (end_imm_use_stmt_p (imm)) return NULL; - link_use_stmts_after (imm->imm_use, imm); + imm->next_stmt_use = link_use_stmts_after (imm->imm_use, imm)->next; +#if defined ENABLE_GIMPLE_CHECKING + var->ssa_name.active_iterated_stmt = USE_STMT (imm->imm_use); +#endif return USE_STMT (imm->imm_use); } @@ -945,15 +997,14 @@ first_imm_use_stmt (imm_use_iterator *imm, tree var) inline gimple * next_imm_use_stmt (imm_use_iterator *imm) { - imm->imm_use = imm->iter_node.next; + imm->imm_use = imm->next_stmt_use; if (end_imm_use_stmt_p (imm)) - { - if (imm->iter_node.prev != NULL) - delink_imm_use (&imm->iter_node); - return NULL; - } + return NULL; - link_use_stmts_after (imm->imm_use, imm); +#if defined ENABLE_GIMPLE_CHECKING + imm->name->ssa_name.active_iterated_stmt = USE_STMT (imm->imm_use); +#endif + imm->next_stmt_use = link_use_stmts_after (imm->imm_use, imm)->next; return USE_STMT (imm->imm_use); } @@ -972,7 +1023,7 @@ first_imm_use_on_stmt (imm_use_iterator *imm) inline bool end_imm_use_on_stmt_p (const imm_use_iterator *imm) { - return (imm->imm_use == &(imm->iter_node)); + return (imm->imm_use == imm->next_stmt_use); } /* Bump to the next use on the stmt IMM refers to, return NULL if done. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7a2f15e..0800f10 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,126 @@ +2025-11-05 Nathaniel Shead <nathanieloshead@gmail.com> + + PR c++/121574 + * g++.dg/modules/internal-17_b.C: Check for diagnostics when + instantiating imported TU-local entities. + +2025-11-05 Nathaniel Shead <nathanieloshead@gmail.com> + + PR c++/121574 + * g++.dg/modules/internal-17_a.C: New test. + * g++.dg/modules/internal-17_b.C: New test. + +2025-11-05 Eric Botcazou <ebotcazou@adacore.com> + + * gnat.dg/specs/discr8.ads: New test. + +2025-11-05 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/122566 + * gfortran.dg/pdt_68.f03: New test. + +2025-11-05 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/122501 + PR fortran/122524 + * gfortran.dg/pdt_66.f03: New test. + * gfortran.dg/pdt_67.f03: New test. + +2025-11-05 Tobias Burnus <tburnus@baylibre.com> + + PR fortran/122570 + * gfortran.dg/gomp/pr122570.f: New test. + +2025-11-05 Artemiy Volkov <artemiy.volkov@arm.com> + + * gcc.dg/tree-ssa/forwprop-43.c: New test. + * gcc.target/aarch64/simd/combine_ext.c: New test. + +2025-11-05 Guo Jie <guojie@loongson.cn> + + * gcc.target/loongarch/widen-mul-rtx-cost-signed.c: Update. + +2025-11-04 Eric Botcazou <ebotcazou@adacore.com> + + * gnat.dg/protected_subtype1.adb: New test. + +2025-11-04 Eric Botcazou <ebotcazou@adacore.com> + + * gnat.dg/specs/generic_inst9.ads: New test. + * gnat.dg/specs/generic_inst9_pkg1.ads: New helper. + * gnat.dg/specs/generic_inst9_pkg2.ads: Likewise. + * gnat.dg/specs/generic_inst9_pkg2-g.ads: Likewise. + +2025-11-04 Uros Bizjak <ubizjak@gmail.com> + + PR target/122390 + * gcc.target/i386/pr122390.c: New test. + * gcc.target/i386/pr122390-1.c: New test. + +2025-11-04 Kees Cook <kees@kernel.org> + + * gcc.target/arc/builtin_fls_const.c: New test. Verify that + const attribute enables CSE optimization for mathematical ARC + builtins by checking that duplicate calls are eliminated and + results are optimized to shift operations. + +2025-11-04 Paul-Antoine Arras <parras@baylibre.com> + + PR fortran/122369 + PR fortran/122508 + * gfortran.dg/gomp/pr122369-1.f90: New test. + * gfortran.dg/gomp/pr122369-2.f90: New test. + * gfortran.dg/gomp/pr122369-3.f90: New test. + * gfortran.dg/gomp/pr122369-4.f90: New test. + * gfortran.dg/gomp/pr122508-1.f90: New test. + * gfortran.dg/gomp/pr122508-2.f90: New test. + +2025-11-04 Siddhesh Poyarekar <siddhesh@gotplt.org> + + PR lto/122515 + * lib/lto.exp (lto-build-archive): New procedure. + (lto-execute-1): Use it. + (lto-link-and-maybe-run, lto-get-options-main): Handle ar-link. + * gcc.dg/lto/pr122515_0.c: New test case. + * gcc.dg/lto/pr122515_1.c: New file. + * gcc.dg/lto/pr122515_2.c: Likewise. + * gcc.dg/lto/pr122515_3.c: Likewise. + * gcc.dg/lto/pr122515_4.c: Likewise. + * gcc.dg/lto/pr122515_5.c: Likewise. + * gcc.dg/lto/pr122515_6.c: Likewise. + * gcc.dg/lto/pr122515_7.c: Likewise. + * gcc.dg/lto/pr122515_8.c: Likewise. + * gcc.dg/lto/pr122515_9.c: Likewise. + +2025-11-04 Nathaniel Shead <nathanieloshead@gmail.com> + + PR c++/122253 + * g++.dg/modules/internal-16.C: New test. + +2025-11-04 Tobias Burnus <tburnus@baylibre.com> + + PR fortran/122513 + * gfortran.dg/pr122513-2.f90: New test. + +2025-11-04 Kishan Parmar <kishan@linux.ibm.com> + + PR rtl-optimization/93738 + * gcc.target/powerpc/rlwimi-2.c: Update expected rldicl count. + +2025-11-04 David Malcolm <dmalcolm@redhat.com> + + PR analyzer/122544 + * g++.dg/analyzer/exception-path-1-sarif.py: New test script. + * g++.dg/analyzer/exception-path-1.C: Add SARIF output, and use + the above to check it. + * g++.dg/analyzer/exception-path-unwind-multiple-2-sarif.py: New + test script. + * g++.dg/analyzer/exception-path-unwind-multiple-2.C: Add SARIF + output, and use the above to check it. + * gcc.dg/analyzer/setjmp-3-sarif.py: New test script. + * gcc.dg/analyzer/setjmp-3.c: Add SARIF output, and use + the above to check it. + 2025-11-03 Eric Botcazou <ebotcazou@adacore.com> * gnat.dg/generic_inst15.adb: New test. diff --git a/gcc/testsuite/g++.dg/analyzer/exception-path-1-sarif.py b/gcc/testsuite/g++.dg/analyzer/exception-path-1-sarif.py new file mode 100644 index 0000000..8958d96 --- /dev/null +++ b/gcc/testsuite/g++.dg/analyzer/exception-path-1-sarif.py @@ -0,0 +1,22 @@ +from sarif import * + +import pytest + +@pytest.fixture(scope='function', autouse=True) +def sarif(): + return sarif_from_env() + +def test_kinds(sarif): + result = get_result_by_index(sarif, 0) + + assert result['level'] == 'note' + + events = result["codeFlows"][0]["threadFlows"][0]['locations'] + + # Event "(1)": "throwing exception of type 'value_error' here..." (index == 0) + assert events[0]['location']['message']['text'] == "throwing exception of type 'value_error' here..." + assert events[0]['kinds'] == ["throw"] + + # Event "(2)": "...catching exception of type 'value_error' here" (index == 1) + assert events[1]['location']['message']['text'] == "...catching exception of type 'value_error' here" + assert events[1]['kinds'] == ["catch"] diff --git a/gcc/testsuite/g++.dg/analyzer/exception-path-1.C b/gcc/testsuite/g++.dg/analyzer/exception-path-1.C index 486ca193..d923d62 100644 --- a/gcc/testsuite/g++.dg/analyzer/exception-path-1.C +++ b/gcc/testsuite/g++.dg/analyzer/exception-path-1.C @@ -1,3 +1,5 @@ +/* { dg-additional-options "-fdiagnostics-add-output=sarif" } */ + /* Verify that we follow the correct paths when we know the typeinfo of an exception. */ @@ -32,3 +34,10 @@ int test () __analyzer_dump_path (); // { dg-bogus "path" } return 0; } + +/* Verify that some JSON was written to a file with the expected name. */ +/* { dg-final { verify-sarif-file } } */ + +/* Use a Python script to verify various properties about the generated + .sarif file: + { dg-final { run-sarif-pytest exception-path-1.C "exception-path-1-sarif.py" } } */ diff --git a/gcc/testsuite/g++.dg/analyzer/exception-path-unwind-multiple-2-sarif.py b/gcc/testsuite/g++.dg/analyzer/exception-path-unwind-multiple-2-sarif.py new file mode 100644 index 0000000..b817a64 --- /dev/null +++ b/gcc/testsuite/g++.dg/analyzer/exception-path-unwind-multiple-2-sarif.py @@ -0,0 +1,23 @@ +from sarif import * + +import pytest + +@pytest.fixture(scope='function', autouse=True) +def sarif(): + return sarif_from_env() + +def test_kinds(sarif): + result = get_result_by_index(sarif, 0) + + assert result['level'] == 'note' + + events = result["codeFlows"][0]["threadFlows"][0]['locations'] + + assert events[-4]['location']['message']['text'] == "throwing exception of type 'value_error' here..." + assert events[-4]['kinds'] == ["throw"] + + assert events[-3]['location']['message']['text'] == "unwinding 2 stack frames" + assert events[-3]['kinds'] == ["unwind"] + + assert events[-2]['location']['message']['text'] == "...catching exception of type 'value_error' here" + assert events[-2]['kinds'] == ["catch"] diff --git a/gcc/testsuite/g++.dg/analyzer/exception-path-unwind-multiple-2.C b/gcc/testsuite/g++.dg/analyzer/exception-path-unwind-multiple-2.C index 2608f17..aa1ff89 100644 --- a/gcc/testsuite/g++.dg/analyzer/exception-path-unwind-multiple-2.C +++ b/gcc/testsuite/g++.dg/analyzer/exception-path-unwind-multiple-2.C @@ -1,3 +1,5 @@ +/* { dg-additional-options "-fdiagnostics-add-output=sarif" } */ + /* Verify that we follow the correct paths when we know the typeinfo of an exception: interprocedural case where unwind multiple frame, failing to match the type. */ @@ -53,3 +55,10 @@ int outer () __analyzer_dump_path (); // { dg-bogus "path" } return 0; } + +/* Verify that some JSON was written to a file with the expected name. */ +/* { dg-final { verify-sarif-file } } */ + +/* Use a Python script to verify various properties about the generated + .sarif file: + { dg-final { run-sarif-pytest exception-path-unwind-multiple-2.C "exception-path-unwind-multiple-2-sarif.py" } } */ diff --git a/gcc/testsuite/g++.dg/modules/internal-16.C b/gcc/testsuite/g++.dg/modules/internal-16.C new file mode 100644 index 0000000..4a928ae --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/internal-16.C @@ -0,0 +1,30 @@ +// PR c++/122253 +// { dg-additional-options "-fmodules -Wtemplate-names-tu-local" } + +export module M; + +template <int> struct ic {}; +struct S { + constexpr operator int() const { return 5; } + constexpr int operator&() const { return 8; } +}; + +template <typename T> inline void a(T) { + T a; + static T b; + ic<a>{}; + ic<b>{}; + ic<&a>{}; + ic<&b>{}; +} + +template <typename T> inline auto b(T x) { + return [&](auto y) { + return [=](auto z) { + return ic<(int)x + (int)&y + (int)z>{}; + }; + }; +} + +template void a(S); +ic<5 + 8 + 5> x = b(S{})(S{})(S{}); diff --git a/gcc/testsuite/g++.dg/modules/internal-17_a.C b/gcc/testsuite/g++.dg/modules/internal-17_a.C new file mode 100644 index 0000000..17eef47 --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/internal-17_a.C @@ -0,0 +1,64 @@ +// PR c++/121574 +// { dg-additional-options "-fmodules -Wno-error=expose-global-module-tu-local -Wtemplate-names-tu-local -Wno-global-module" } +// { dg-module-cmi M } + +module; + +namespace { + void foo() {} + inline int bar = 123; + template <typename> void qux() {} + template void qux<int>(); + +#pragma GCC diagnostic push +#pragma GCC diagnostic ignored "-Wexpose-global-module-tu-local" + void foo_ignored() {} + inline int bar_ignored = 123; + template <typename> void qux_ignored() {} + template void qux_ignored<int>(); +#pragma GCC diagnostic pop +}; + +export module M; + +export inline void a() { // { dg-warning "exposes TU-local" } + foo(); + int x = bar; +} + +export inline void b() { + foo_ignored(); + int x = bar_ignored; +} + +export template <typename T> +void c() { // { dg-warning "refers to TU-local" } + foo(); + int x = bar; +} + +export template <typename T> +void d() { + foo_ignored(); + int x = bar_ignored; +} + +export inline void e() { // { dg-warning "exposes TU-local" } + foo(); + int result = bar_ignored; +} + +export template <typename T> +void f() { // { dg-warning "refers to TU-local" } + foo_ignored(); + int result = bar; +} + +export inline void g() { // { dg-warning "exposes TU-local" } + qux<int>(); +} + +export template <typename> +void h() { + qux_ignored<int>(); +} diff --git a/gcc/testsuite/g++.dg/modules/internal-17_b.C b/gcc/testsuite/g++.dg/modules/internal-17_b.C new file mode 100644 index 0000000..f900926 --- /dev/null +++ b/gcc/testsuite/g++.dg/modules/internal-17_b.C @@ -0,0 +1,60 @@ +// PR c++/121576 +// { dg-additional-options "-fmodules -Wno-error=expose-global-module-tu-local -Wtemplate-names-tu-local -Wno-global-module" } +// { dg-module-cmi !X } + +module; + +static inline int x // { dg-error "TU-local" } + // { dg-message "exposed elsewhere" "" { target *-*-* } .-1 } + = []{ return 1; }(); // { dg-message "internal" } + +static inline int y = []{ return 2; }(); // { dg-bogus "" } + +namespace { + struct S {}; + template <typename> void tmpl(); + +#pragma GCC diagnostic push +#pragma GCC diagnostic ignored "-Wexpose-global-module-tu-local" + struct S_ignored {}; + template <typename> void tmpl_ignored(); +#pragma GCC diagnostic pop +} + +export module X; +import M; + +void test_usage() { + a(); + b(); + c<int>(); // { dg-message "required from here" } + d<int>(); // { dg-bogus "" } + e(); + f<int>(); // { dg-message "required from here" } + g(); + h<int>(); // { dg-bogus "" } + + // { dg-warning "instantiation exposes TU-local entity" "" { target *-*-* } 0 } +} + +inline void expose() { // { dg-warning "exposes TU-local" } + int result = x; +} + +// Internal linkage types always hard error +inline void expose_struct() { // { dg-error "exposes TU-local" } + S s; +} +inline void still_expose_struct() { // { dg-error "exposes TU-local" } + S_ignored s; +} + +// Template instantiations occuring in module purview are not ignored, +// as it's too hard to tell if the instantiation will accidentally rely +// on something in the purview or not. +inline void expose_tmpl() { // { dg-error "exposes TU-local" } + tmpl<int>(); +} +inline void still_expose_tmpl() { // { dg-error "exposes TU-local" } + tmpl_ignored<int>(); +} diff --git a/gcc/testsuite/gcc.dg/analyzer/setjmp-3-sarif.py b/gcc/testsuite/gcc.dg/analyzer/setjmp-3-sarif.py new file mode 100644 index 0000000..922d338 --- /dev/null +++ b/gcc/testsuite/gcc.dg/analyzer/setjmp-3-sarif.py @@ -0,0 +1,23 @@ +from sarif import * + +import pytest + +@pytest.fixture(scope='function', autouse=True) +def sarif(): + return sarif_from_env() + +def test_kinds(sarif): + result = get_result_by_index(sarif, 0) + + assert result['level'] == 'note' + + events = result["codeFlows"][0]["threadFlows"][0]['locations'] + + assert events[1]['location']['message']['text'] == "'setjmp' called here" + assert events[1]['kinds'] == ["setjmp"] + + assert events[6]['location']['message']['text'] == "rewinding from 'longjmp' in 'inner'..." + assert events[6]['kinds'] == ["longjmp"] + + assert events[7]['location']['message']['text'].startswith("...to 'setjmp' in 'outer'") + assert events[7]['kinds'] == ["longjmp"] diff --git a/gcc/testsuite/gcc.dg/analyzer/setjmp-3.c b/gcc/testsuite/gcc.dg/analyzer/setjmp-3.c index 3e4f870..a19ce84 100644 --- a/gcc/testsuite/gcc.dg/analyzer/setjmp-3.c +++ b/gcc/testsuite/gcc.dg/analyzer/setjmp-3.c @@ -1,4 +1,6 @@ /* { dg-additional-options "-fdiagnostics-show-line-numbers -fdiagnostics-path-format=inline-events -fdiagnostics-show-caret" } */ +/* { dg-additional-options "-fdiagnostics-add-output=sarif" } */ + /* { dg-enable-nn-line-numbers "" } */ /* { dg-require-effective-target indirect_jumps } */ @@ -107,3 +109,10 @@ void outer (void) | | (11) here | { dg-end-multiline-output "" } */ + +/* Verify that some JSON was written to a file with the expected name. */ +/* { dg-final { verify-sarif-file } } */ + +/* Use a Python script to verify various properties about the generated + .sarif file: + { dg-final { run-sarif-pytest setjmp-3.c "setjmp-3-sarif.py" } } */ diff --git a/gcc/testsuite/gcc.dg/cmp-mem-const-1.c b/gcc/testsuite/gcc.dg/cmp-mem-const-1.c index 0b0e733..4f94902 100644 --- a/gcc/testsuite/gcc.dg/cmp-mem-const-1.c +++ b/gcc/testsuite/gcc.dg/cmp-mem-const-1.c @@ -1,6 +1,7 @@ /* { dg-do compile { target { lp64 } } } */ /* { dg-options "-O2 -fdump-rtl-combine-details" } */ /* { dg-final { scan-rtl-dump "narrow comparison from mode .I to QI" "combine" } } */ +/* { dg-skip-if "" { riscv*-*-* } } */ typedef __UINT64_TYPE__ uint64_t; diff --git a/gcc/testsuite/gcc.dg/cmp-mem-const-2.c b/gcc/testsuite/gcc.dg/cmp-mem-const-2.c index 8022137..12d962a 100644 --- a/gcc/testsuite/gcc.dg/cmp-mem-const-2.c +++ b/gcc/testsuite/gcc.dg/cmp-mem-const-2.c @@ -1,6 +1,7 @@ /* { dg-do compile { target { lp64 } } } */ /* { dg-options "-O2 -fdump-rtl-combine-details" } */ /* { dg-final { scan-rtl-dump "narrow comparison from mode .I to QI" "combine" } } */ +/* { dg-skip-if "" { riscv*-*-* } } */ typedef __UINT64_TYPE__ uint64_t; diff --git a/gcc/testsuite/gcc.dg/lto/pr122515_0.c b/gcc/testsuite/gcc.dg/lto/pr122515_0.c new file mode 100644 index 0000000..fb2fa8b --- /dev/null +++ b/gcc/testsuite/gcc.dg/lto/pr122515_0.c @@ -0,0 +1,9 @@ +/* { dg-lto-do ar-link } */ +/* { dg-lto-options { { -flto=auto -ffat-lto-objects } } } */ + +extern int bar_7 (int); + +int main (void) +{ + return bar_7 (42); +} diff --git a/gcc/testsuite/gcc.dg/lto/pr122515_1.c b/gcc/testsuite/gcc.dg/lto/pr122515_1.c new file mode 100644 index 0000000..f676c4a --- /dev/null +++ b/gcc/testsuite/gcc.dg/lto/pr122515_1.c @@ -0,0 +1,12 @@ +typedef struct { + int num; + int foo[40000000]; +} A_1; + +A_1 a1_1 = {1}; +A_1 a2_1 = {2}; + +int bar_1 (int i) +{ + return i++; +} diff --git a/gcc/testsuite/gcc.dg/lto/pr122515_2.c b/gcc/testsuite/gcc.dg/lto/pr122515_2.c new file mode 100644 index 0000000..acda878 --- /dev/null +++ b/gcc/testsuite/gcc.dg/lto/pr122515_2.c @@ -0,0 +1,12 @@ +typedef struct { + int num; + int foo[40000000]; +} A_2; + +A_2 a1_2 = {1}; +A_2 a2_2 = {2}; + +int bar_2 (int i) +{ + return i++; +} diff --git a/gcc/testsuite/gcc.dg/lto/pr122515_3.c b/gcc/testsuite/gcc.dg/lto/pr122515_3.c new file mode 100644 index 0000000..7223e9f --- /dev/null +++ b/gcc/testsuite/gcc.dg/lto/pr122515_3.c @@ -0,0 +1,12 @@ +typedef struct { + int num; + int foo[40000000]; +} A_3; + +A_3 a1_3 = {1}; +A_3 a2_3 = {2}; + +int bar_3 (int i) +{ + return i++; +} diff --git a/gcc/testsuite/gcc.dg/lto/pr122515_4.c b/gcc/testsuite/gcc.dg/lto/pr122515_4.c new file mode 100644 index 0000000..51754ae --- /dev/null +++ b/gcc/testsuite/gcc.dg/lto/pr122515_4.c @@ -0,0 +1,12 @@ +typedef struct { + int num; + int foo[40000000]; +} A_4; + +A_4 a1_4 = {1}; +A_4 a2_4 = {2}; + +int bar_4 (int i) +{ + return i++; +} diff --git a/gcc/testsuite/gcc.dg/lto/pr122515_5.c b/gcc/testsuite/gcc.dg/lto/pr122515_5.c new file mode 100644 index 0000000..cca1787 --- /dev/null +++ b/gcc/testsuite/gcc.dg/lto/pr122515_5.c @@ -0,0 +1,12 @@ +typedef struct { + int num; + int foo[40000000]; +} A_5; + +A_5 a1_5 = {1}; +A_5 a2_5 = {2}; + +int bar_5 (int i) +{ + return i++; +} diff --git a/gcc/testsuite/gcc.dg/lto/pr122515_6.c b/gcc/testsuite/gcc.dg/lto/pr122515_6.c new file mode 100644 index 0000000..98e6213 --- /dev/null +++ b/gcc/testsuite/gcc.dg/lto/pr122515_6.c @@ -0,0 +1,12 @@ +typedef struct { + int num; + int foo[40000000]; +} A_6; + +A_6 a1_6 = {1}; +A_6 a2_6 = {2}; + +int bar_6 (int i) +{ + return i++; +} diff --git a/gcc/testsuite/gcc.dg/lto/pr122515_7.c b/gcc/testsuite/gcc.dg/lto/pr122515_7.c new file mode 100644 index 0000000..7f27fff --- /dev/null +++ b/gcc/testsuite/gcc.dg/lto/pr122515_7.c @@ -0,0 +1,12 @@ +typedef struct { + int num; + int foo[40000000]; +} A_7; + +A_7 a1_7 = {1}; +A_7 a2_7 = {2}; + +int bar_7 (int i) +{ + return i++; +} diff --git a/gcc/testsuite/gcc.dg/lto/pr122515_8.c b/gcc/testsuite/gcc.dg/lto/pr122515_8.c new file mode 100644 index 0000000..f3d56bd --- /dev/null +++ b/gcc/testsuite/gcc.dg/lto/pr122515_8.c @@ -0,0 +1,12 @@ +typedef struct { + int num; + int foo[40000000]; +} A_8; + +A_8 a1_8 = {1}; +A_8 a2_8 = {2}; + +int bar_8 (int i) +{ + return i++; +} diff --git a/gcc/testsuite/gcc.dg/lto/pr122515_9.c b/gcc/testsuite/gcc.dg/lto/pr122515_9.c new file mode 100644 index 0000000..2fdd04c --- /dev/null +++ b/gcc/testsuite/gcc.dg/lto/pr122515_9.c @@ -0,0 +1,12 @@ +typedef struct { + int num; + int foo[40000000]; +} A_9; + +A_9 a1_9 = {1}; +A_9 a2_9 = {2}; + +int bar_9 (int i) +{ + return i++; +} diff --git a/gcc/testsuite/gcc.dg/pr113632.c b/gcc/testsuite/gcc.dg/pr113632.c new file mode 100644 index 0000000..dd49b66 --- /dev/null +++ b/gcc/testsuite/gcc.dg/pr113632.c @@ -0,0 +1,28 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-evrp" } */ + +void dummy(void); +_Bool f(unsigned long a) +{ + _Bool cmp = a > 8192; + if (cmp) goto then; else goto e; +then: + unsigned long t = __builtin_clzl(a); // [0,50] + t^=63; // [13,63] + if (t < 13 || t >63) + dummy (); +e: + return 0; +} + +void f2(int x) +{ + if (x <= 0 || x == 2 || x == 4 || x == 6) + return; + /* x = [1, 1][3, 3][5, 5][7, 2147483647] */ + /* x ^ 6 should be non-zero. */ + if ((x ^ 6) == 0) + dummy (); +} + +/* { dg-final { scan-tree-dump-not "dummy" "evrp" } } */ diff --git a/gcc/testsuite/gcc.dg/torture/pr122502-2.c b/gcc/testsuite/gcc.dg/torture/pr122502-2.c new file mode 100644 index 0000000..36a114d --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr122502-2.c @@ -0,0 +1,23 @@ +/* { dg-do compile } */ + +typedef struct { + int mant; + int exp; +} SoftFloat; +SoftFloat __trans_tmp_8, main___trans_tmp_5; +static SoftFloat av_normalize_sf(SoftFloat a) { + while (a.mant + 536870911 < 1073741823) { + a.mant += a.mant; + a.exp -= 1; + } + return a; +} +void main() { + main___trans_tmp_5 = av_normalize_sf((SoftFloat){1, 29 + 1}); + SoftFloat sf1 = main___trans_tmp_5; + for (;;) { + int t = main___trans_tmp_5.exp - sf1.exp; + if (t < 2) + sf1 = __trans_tmp_8; + } +} diff --git a/gcc/testsuite/gcc.dg/tree-ssa/forwprop-43.c b/gcc/testsuite/gcc.dg/tree-ssa/forwprop-43.c new file mode 100644 index 0000000..f0f6170 --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/forwprop-43.c @@ -0,0 +1,169 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-forwprop1" } */ +/* { dg-additional-options "-fgimple" } */ + +#include <stdint.h> + +typedef int32_t int32x4_t __attribute__((vector_size(16))); +typedef int32_t int32x2_t __attribute__((vector_size(8))); +typedef int32_t int32x1_t __attribute__((vector_size(4))); + +int32x4_t __GIMPLE (ssa) +foo (int32x4_t x) +{ + int32x2_t _1; + int32x2_t _2; + int32x4_t _6; + +__BB(2): + _1 = __BIT_FIELD_REF <int32x2_t> (x, 64, 64); + _2 = __BIT_FIELD_REF <int32x2_t> (x, 64, 0); + _6 = _Literal (int32x4_t) { _1, _2 }; + return _6; +} + +int32x4_t __GIMPLE (ssa) +foo2 (int32x4_t x) +{ + int32x1_t _1; + int32x1_t _2; + int32x1_t _3; + int32x1_t _4; + int32x4_t _6; + +__BB(2): + _1 = __BIT_FIELD_REF <int32x1_t> (x, 32, 64); + _2 = __BIT_FIELD_REF <int32x1_t> (x, 32, 96); + _3 = __BIT_FIELD_REF <int32x1_t> (x, 32, 0); + _4 = __BIT_FIELD_REF <int32x1_t> (x, 32, 32); + _6 = _Literal (int32x4_t) { _1, _2, _3, _4 }; + return _6; +} + +int32x4_t __GIMPLE (ssa) +foo3 (int32x4_t x, int32x4_t y) +{ + int32x2_t _1; + int32x2_t _2; + int32x4_t _6; + +__BB(2): + _1 = __BIT_FIELD_REF <int32x2_t> (x, 64, 64); + _2 = __BIT_FIELD_REF <int32x2_t> (y, 64, 0); + _6 = _Literal (int32x4_t) { _1, _2 }; + return _6; +} + +int32x4_t __GIMPLE (ssa) +foo4 (int32x4_t x, int32x4_t y) +{ + int32x1_t _1; + int32x1_t _2; + int32x1_t _3; + int32x1_t _4; + int32x4_t _6; + +__BB(2): + _1 = __BIT_FIELD_REF <int32x1_t> (x, 32, 64); + _2 = __BIT_FIELD_REF <int32x1_t> (y, 32, 96); + _3 = __BIT_FIELD_REF <int32x1_t> (x, 32, 0); + _4 = __BIT_FIELD_REF <int32x1_t> (y, 32, 32); + _6 = _Literal (int32x4_t) { _1, _2, _3, _4 }; + return _6; +} + +int32x4_t __GIMPLE (ssa) +foo5 (int32x4_t x) +{ + int32x2_t _1; + int32x2_t _2; + int32x4_t _6; + +__BB(2): + _1 = __BIT_FIELD_REF <int32x2_t> (x, 64, 64); + _2 = _Literal (int32x2_t) { 1, 2 }; + _6 = _Literal (int32x4_t) { _1, _2 }; + return _6; +} + +int32x4_t __GIMPLE (ssa) +foo6 (int32x4_t x, int32_t y) +{ + int32x2_t _1; + int32x2_t _2; + int32x4_t _6; + +__BB(2): + _1 = __BIT_FIELD_REF <int32x2_t> (x, 64, 64); + _2 = _Literal (int32x2_t) { y, y }; + _6 = _Literal (int32x4_t) { _1, _2 }; + return _6; +} + +int32x4_t __GIMPLE (ssa) +foo7 (int32x4_t x) +{ + int32x2_t _1; + int32x2_t _2; + int32x4_t _6; + +__BB(2): + _1 = __BIT_FIELD_REF <int32x2_t> (x, 64, 64); + _2 = _Literal (int32x2_t) { 1, 2 }; + _6 = _Literal (int32x4_t) { _2, _1 }; + return _6; +} + +int32x4_t __GIMPLE (ssa) +foo8 (int32x4_t x, int32_t y) +{ + int32x2_t _1; + int32x2_t _2; + int32x4_t _6; + +__BB(2): + _1 = __BIT_FIELD_REF <int32x2_t> (x, 64, 64); + _2 = _Literal (int32x2_t) { y, y }; + _6 = _Literal (int32x4_t) { _2, _1 }; + return _6; +} + +int32x4_t __GIMPLE (ssa) +foo9 (int32x4_t x) +{ + int32x1_t _1; + int32x1_t _2; + int32x1_t _3; + int32x1_t _4; + int32x4_t _6; + +__BB(2): + _1 = __BIT_FIELD_REF <int32x1_t> (x, 32, 96); + _2 = __BIT_FIELD_REF <int32x1_t> (x, 32, 64); + _3 = _Literal (int32x1_t) { 1 }; + _4 = _Literal (int32x1_t) { 1 }; + _6 = _Literal (int32x4_t) { _3, _4, _1, _2 }; + return _6; +} + +int32x4_t __GIMPLE (ssa) +foo10 (int32x4_t x, int32_t y) +{ + int32x1_t _1; + int32x1_t _2; + int32x1_t _3; + int32x1_t _4; + int32x4_t _6; + +__BB(2): + _1 = __BIT_FIELD_REF <int32x1_t> (x, 32, 96); + _2 = __BIT_FIELD_REF <int32x1_t> (x, 32, 64); + _3 = _Literal (int32x1_t) { y }; + _4 = _Literal (int32x1_t) { y }; + _6 = _Literal (int32x4_t) { _3, _4, _1, _2 }; + + return _6; +} + + +/* { dg-final { scan-tree-dump-times "VEC_PERM_EXPR" 10 "forwprop1" } } */ diff --git a/gcc/testsuite/gcc.target/aarch64/simd/combine_ext.c b/gcc/testsuite/gcc.target/aarch64/simd/combine_ext.c new file mode 100644 index 0000000..f10a2c6 --- /dev/null +++ b/gcc/testsuite/gcc.target/aarch64/simd/combine_ext.c @@ -0,0 +1,46 @@ +/* { dg-do compile } */ +/* { dg-options "-O1 -fdump-tree-optimized" } */ + +#include <arm_neon.h> + +#ifndef TEST_COMBINE_HIGH_LOW_1 +#define TEST_COMBINE_HIGH_LOW_1(TYPE, SUFF) \ + TYPE rev_##TYPE##_1 (TYPE x) \ + { \ + return vcombine_##SUFF (vget_high_##SUFF (x), vget_low_##SUFF (x)); \ + } +#endif + +#ifndef TEST_COMBINE_HIGH_LOW_2 +#define TEST_COMBINE_HIGH_LOW_2(TYPE, SUFF) \ + TYPE rev_##TYPE##_2 (TYPE x, TYPE y) \ + { \ + return vcombine_##SUFF (vget_high_##SUFF (x), vget_low_##SUFF (y)); \ + } +#endif + +TEST_COMBINE_HIGH_LOW_1 (int8x16_t, s8) +TEST_COMBINE_HIGH_LOW_1 (int16x8_t, s16) +TEST_COMBINE_HIGH_LOW_1 (int32x4_t, s32) +TEST_COMBINE_HIGH_LOW_1 (int64x2_t, s64) +TEST_COMBINE_HIGH_LOW_1 (uint8x16_t, u8) +TEST_COMBINE_HIGH_LOW_1 (uint16x8_t, u16) +TEST_COMBINE_HIGH_LOW_1 (uint32x4_t, u32) +TEST_COMBINE_HIGH_LOW_1 (uint64x2_t, u64) +TEST_COMBINE_HIGH_LOW_1 (float16x8_t, f16) +TEST_COMBINE_HIGH_LOW_1 (float32x4_t, f32) + +TEST_COMBINE_HIGH_LOW_2 (int8x16_t, s8) +TEST_COMBINE_HIGH_LOW_2 (int16x8_t, s16) +TEST_COMBINE_HIGH_LOW_2 (int32x4_t, s32) +TEST_COMBINE_HIGH_LOW_2 (int64x2_t, s64) +TEST_COMBINE_HIGH_LOW_2 (uint8x16_t, u8) +TEST_COMBINE_HIGH_LOW_2 (uint16x8_t, u16) +TEST_COMBINE_HIGH_LOW_2 (uint32x4_t, u32) +TEST_COMBINE_HIGH_LOW_2 (uint64x2_t, u64) +TEST_COMBINE_HIGH_LOW_2 (float16x8_t, f16) +TEST_COMBINE_HIGH_LOW_2 (float32x4_t, f32) + +/* { dg-final { scan-tree-dump-times "VEC_PERM_EXPR" 20 "optimized" } } */ +/* { dg-final { scan-assembler-times {ext\tv0.16b, v0.16b, v0.16b, #8} 10 } } */ +/* { dg-final { scan-assembler-times {ext\tv0.16b, v0.16b, v1.16b, #8} 10 } } */ diff --git a/gcc/testsuite/gcc.target/arc/builtin_fls_const.c b/gcc/testsuite/gcc.target/arc/builtin_fls_const.c new file mode 100644 index 0000000..35629ff --- /dev/null +++ b/gcc/testsuite/gcc.target/arc/builtin_fls_const.c @@ -0,0 +1,35 @@ +/* Test that const attribute enables CSE optimization for ARC builtins. */ +/* { dg-do compile } */ +/* { dg-options "-O2" } */ + +int test_fls_cse(int x) +{ + /* Two calls to the same const builtin with same argument should + be optimized to a single call plus a multiply-by-2 operation. */ + int a = __builtin_arc_fls(x); + int b = __builtin_arc_fls(x); + return a + b; +} + +int test_ffs_cse(int x) +{ + /* Same pattern for __builtin_arc_ffs. */ + int a = __builtin_arc_ffs(x); + int b = __builtin_arc_ffs(x); + return a + b; +} + +int test_norm_cse(int x) +{ + /* Same pattern for __builtin_arc_norm. */ + int a = __builtin_arc_norm(x); + int b = __builtin_arc_norm(x); + return a + b; +} + +/* { dg-final { scan-assembler-times "fls\\s+" 1 } } */ +/* { dg-final { scan-assembler-times "ffs\\s+" 1 } } */ +/* { dg-final { scan-assembler-times "norm\\s+" 1 } } */ + +/* Verify that the result is multiplied by 2 using left shift. */ +/* { dg-final { scan-assembler "asl_s\\s+.*,.*,1" } } */ diff --git a/gcc/testsuite/gcc.target/arm/lceil-vcvt_1.c b/gcc/testsuite/gcc.target/arm/lceil-vcvt_1.c index a8afab1..a8f3729 100644 --- a/gcc/testsuite/gcc.target/arm/lceil-vcvt_1.c +++ b/gcc/testsuite/gcc.target/arm/lceil-vcvt_1.c @@ -1,7 +1,7 @@ /* { dg-do compile } */ /* { dg-skip-if "-mpure-code supports M-profile only" { *-*-* } { "-mpure-code" } } */ /* { dg-require-effective-target arm_v8_vfp_ok } */ -/* { dg-options "-O2 -march=armv8-a" } */ +/* { dg-options "-O2" } */ /* { dg-add-options arm_v8_vfp } */ int diff --git a/gcc/testsuite/gcc.target/arm/lfloor-vcvt_1.c b/gcc/testsuite/gcc.target/arm/lfloor-vcvt_1.c index b8eb1b0..5655fbb 100644 --- a/gcc/testsuite/gcc.target/arm/lfloor-vcvt_1.c +++ b/gcc/testsuite/gcc.target/arm/lfloor-vcvt_1.c @@ -1,7 +1,7 @@ /* { dg-do compile } */ /* { dg-skip-if "-mpure-code supports M-profile only" { *-*-* } { "-mpure-code" } } */ /* { dg-require-effective-target arm_v8_vfp_ok } */ -/* { dg-options "-O2 -march=armv8-a" } */ +/* { dg-options "-O2" } */ /* { dg-add-options arm_v8_vfp } */ int diff --git a/gcc/testsuite/gcc.target/arm/lround-vcvt_1.c b/gcc/testsuite/gcc.target/arm/lround-vcvt_1.c index 4c52a83..799cb8b 100644 --- a/gcc/testsuite/gcc.target/arm/lround-vcvt_1.c +++ b/gcc/testsuite/gcc.target/arm/lround-vcvt_1.c @@ -1,7 +1,7 @@ /* { dg-do compile } */ /* { dg-skip-if "-mpure-code supports M-profile only" { *-*-* } { "-mpure-code" } } */ /* { dg-require-effective-target arm_v8_vfp_ok } */ -/* { dg-options "-O2 -march=armv8-a -ffast-math" } */ +/* { dg-options "-O2 -ffast-math" } */ /* { dg-add-options arm_v8_vfp } */ int diff --git a/gcc/testsuite/gcc.target/arm/vrinta-ce.c b/gcc/testsuite/gcc.target/arm/vrinta-ce.c index 092d914..60da9ec 100644 --- a/gcc/testsuite/gcc.target/arm/vrinta-ce.c +++ b/gcc/testsuite/gcc.target/arm/vrinta-ce.c @@ -1,7 +1,7 @@ /* { dg-do compile } */ /* { dg-skip-if "-mpure-code supports M-profile only" { *-*-* } { "-mpure-code" } } */ /* { dg-require-effective-target arm_v8_vfp_ok } */ -/* { dg-options "-O2 -marm -march=armv8-a" } */ +/* { dg-options "-O2 -marm" } */ /* { dg-add-options arm_v8_vfp } */ double foo (double a) diff --git a/gcc/testsuite/gcc.target/i386/pr122390-1.c b/gcc/testsuite/gcc.target/i386/pr122390-1.c new file mode 100644 index 0000000..9120dd4 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr122390-1.c @@ -0,0 +1,26 @@ +/* PR target/122390 */ +/* { dg-do compile } */ +/* { dg-options "-O2" } */ + +int f (int); +int g (int); + +int f1 (unsigned a, unsigned b) +{ + unsigned t = a < b; + int tt = a + b + t; + if (tt < 0) + return f(tt); + return g(tt); +} + +int f2 (unsigned a, unsigned b) +{ + unsigned t = a < b; + int tt = a - b - t; + if (tt < 0) + return f(tt); + return g(tt); +} + +/* { dg-final { scan-assembler-not "test" } } */ diff --git a/gcc/testsuite/gcc.target/i386/pr122390.c b/gcc/testsuite/gcc.target/i386/pr122390.c new file mode 100644 index 0000000..a12849a --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/pr122390.c @@ -0,0 +1,44 @@ +/* PR target/122390 */ +/* { dg-do compile } */ +/* { dg-options "-O2" } */ + +int f (int); +int g (int); + +int f1 (unsigned a, unsigned b) +{ + unsigned t = a < b; + int tt = a + t; + if (tt == 0) + return f(tt); + return g(tt); +} + +int f2 (unsigned a, unsigned b) +{ + unsigned t = a <= b; + int tt = a + t; + if (tt < 0) + return f(tt); + return g(tt); +} + +int f3 (unsigned a, unsigned b) +{ + unsigned t = a > b; + int tt = a - t; + if (tt == 0) + return f(tt); + return g(tt); +} + +int f4 (unsigned a, unsigned b) +{ + unsigned t = a >= b; + int tt = a - t; + if (tt < 0) + return f(tt); + return g(tt); +} + +/* { dg-final { scan-assembler-not "test" } } */ diff --git a/gcc/testsuite/gcc.target/loongarch/vect-frint-no-inexact.c b/gcc/testsuite/gcc.target/loongarch/vect-frint-no-inexact.c index 7bbaf1f..e20eaea 100644 --- a/gcc/testsuite/gcc.target/loongarch/vect-frint-no-inexact.c +++ b/gcc/testsuite/gcc.target/loongarch/vect-frint-no-inexact.c @@ -1,5 +1,5 @@ /* { dg-do compile } */ -/* { dg-options "-O2 -mabi=lp64d -mdouble-float -fno-math-errno -fno-fp-int-builtin-inexact -mlasx" } */ +/* { dg-options "-O2 -mabi=lp64d -mdouble-float -fno-math-errno -fno-fp-int-builtin-inexact -mlasx -mcmodel=normal" } */ #include "vect-frint.c" diff --git a/gcc/testsuite/gcc.target/loongarch/vect-frint-scalar-no-inexact.c b/gcc/testsuite/gcc.target/loongarch/vect-frint-scalar-no-inexact.c index 002e3b9..d5f09335 100644 --- a/gcc/testsuite/gcc.target/loongarch/vect-frint-scalar-no-inexact.c +++ b/gcc/testsuite/gcc.target/loongarch/vect-frint-scalar-no-inexact.c @@ -1,5 +1,5 @@ /* { dg-do compile } */ -/* { dg-options "-O2 -mlsx -fno-fp-int-builtin-inexact" } */ +/* { dg-options "-O2 -mlsx -fno-fp-int-builtin-inexact -mcmodel=normal" } */ #include "vect-frint-scalar.c" diff --git a/gcc/testsuite/gcc.target/loongarch/vect-frint-scalar.c b/gcc/testsuite/gcc.target/loongarch/vect-frint-scalar.c index dbcb906..171ba98 100644 --- a/gcc/testsuite/gcc.target/loongarch/vect-frint-scalar.c +++ b/gcc/testsuite/gcc.target/loongarch/vect-frint-scalar.c @@ -1,5 +1,5 @@ /* { dg-do compile } */ -/* { dg-options "-O2 -mlsx -ffp-int-builtin-inexact" } */ +/* { dg-options "-O2 -mlsx -ffp-int-builtin-inexact -mcmodel=normal" } */ #define test(func, suffix) \ __typeof__ (1.##suffix) \ diff --git a/gcc/testsuite/gcc.target/loongarch/vect-frint.c b/gcc/testsuite/gcc.target/loongarch/vect-frint.c index 6bf211e..bda041b 100644 --- a/gcc/testsuite/gcc.target/loongarch/vect-frint.c +++ b/gcc/testsuite/gcc.target/loongarch/vect-frint.c @@ -1,5 +1,5 @@ /* { dg-do compile } */ -/* { dg-options "-O2 -mabi=lp64d -mdouble-float -fno-math-errno -ffp-int-builtin-inexact -mlasx" } */ +/* { dg-options "-O2 -mabi=lp64d -mdouble-float -fno-math-errno -ffp-int-builtin-inexact -mlasx -mcmodel=normal" } */ float out_x[8]; double out_y[4]; diff --git a/gcc/testsuite/gcc.target/loongarch/vect-ftint-no-inexact.c b/gcc/testsuite/gcc.target/loongarch/vect-ftint-no-inexact.c index 61918be..3fa9753 100644 --- a/gcc/testsuite/gcc.target/loongarch/vect-ftint-no-inexact.c +++ b/gcc/testsuite/gcc.target/loongarch/vect-ftint-no-inexact.c @@ -1,5 +1,5 @@ /* { dg-do compile } */ -/* { dg-options "-O2 -mabi=lp64d -mdouble-float -fno-math-errno -fno-fp-int-builtin-inexact -mlasx" } */ +/* { dg-options "-O2 -mabi=lp64d -mdouble-float -fno-math-errno -fno-fp-int-builtin-inexact -mlasx -mcmodel=normal" } */ #include "vect-ftint.c" diff --git a/gcc/testsuite/gcc.target/loongarch/vect-ftint.c b/gcc/testsuite/gcc.target/loongarch/vect-ftint.c index c4962ed..96da3cd 100644 --- a/gcc/testsuite/gcc.target/loongarch/vect-ftint.c +++ b/gcc/testsuite/gcc.target/loongarch/vect-ftint.c @@ -1,5 +1,5 @@ /* { dg-do compile } */ -/* { dg-options "-O2 -mabi=lp64d -mdouble-float -fno-math-errno -ffp-int-builtin-inexact -mlasx" } */ +/* { dg-options "-O2 -mabi=lp64d -mdouble-float -fno-math-errno -ffp-int-builtin-inexact -mlasx -mcmodel=normal" } */ int out_x[8]; long out_y[4]; diff --git a/gcc/testsuite/gcc.target/loongarch/widen-mul-rtx-cost-signed.c b/gcc/testsuite/gcc.target/loongarch/widen-mul-rtx-cost-signed.c index 1e1e75f..61d21a8 100644 --- a/gcc/testsuite/gcc.target/loongarch/widen-mul-rtx-cost-signed.c +++ b/gcc/testsuite/gcc.target/loongarch/widen-mul-rtx-cost-signed.c @@ -9,5 +9,4 @@ test (int a) return a / 3; } -/* { dg-final { scan-assembler {\tmulw.d.w\t} } } */ /* { dg-final { scan-assembler-not {\tdiv.w\t} } } */ diff --git a/gcc/testsuite/gcc.target/powerpc/rlwimi-2.c b/gcc/testsuite/gcc.target/powerpc/rlwimi-2.c index bafa371..afbde0e 100644 --- a/gcc/testsuite/gcc.target/powerpc/rlwimi-2.c +++ b/gcc/testsuite/gcc.target/powerpc/rlwimi-2.c @@ -6,7 +6,7 @@ /* { dg-final { scan-assembler-times {(?n)^\s+blr} 6750 } } */ /* { dg-final { scan-assembler-times {(?n)^\s+mr} 643 { target ilp32 } } } */ /* { dg-final { scan-assembler-times {(?n)^\s+mr} 11 { target lp64 } } } */ -/* { dg-final { scan-assembler-times {(?n)^\s+rldicl} 7790 { target lp64 } } } */ +/* { dg-final { scan-assembler-times {(?n)^\s+rldicl} 6754 { target lp64 } } } */ /* { dg-final { scan-assembler-times {(?n)^\s+rlwimi} 1692 { target ilp32 } } } */ /* { dg-final { scan-assembler-times {(?n)^\s+rlwimi} 1666 { target lp64 } } } */ diff --git a/gcc/testsuite/gcc.target/riscv/czero-bext.c b/gcc/testsuite/gcc.target/riscv/czero-bext.c new file mode 100644 index 0000000..54a6d6f --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/czero-bext.c @@ -0,0 +1,17 @@ +/* { dg-do compile } */ +/* { dg-options "-O2 -march=rv64gbc_zicond -mabi=lp64d" { target { rv64 } } } */ +/* { dg-options "-O2 -march=rv32gbc_zicond -mabi=ilp32" { target { rv32 } } } */ + +bool isValidAncestorType(int type) { + if (type == 0 || type == 6 || type == 4) { + return true; + } + return false; +} + + + +/* { dg-final { scan-assembler "czero.nez\t" } } */ +/* { dg-final { scan-assembler "sgtu\t" } } */ +/* { dg-final { scan-assembler-not "bgtu\t" } } */ + diff --git a/gcc/testsuite/gcc.target/riscv/pr121136.c b/gcc/testsuite/gcc.target/riscv/pr121136.c new file mode 100644 index 0000000..77585f4 --- /dev/null +++ b/gcc/testsuite/gcc.target/riscv/pr121136.c @@ -0,0 +1,103 @@ +/* { dg-do compile } */ +/* { dg-options "-std=gnu23 -O2 -march=rv64gc -mabi=lp64d" { target rv64} } */ +/* { dg-options "-std=gnu23 -O2 -march=rv32gc -mabi=ilp32" { target rv32} } */ + +/* We need to adjust the constant so this works for rv32 and rv64. */ +#if __riscv_xlen == 32 +#define ONE 1U +#define TYPE unsigned int +#define CTZ __builtin_ctz +#else +#define ONE 1UL +#define TYPE unsigned long +#define CTZ __builtin_ctzl +#endif + +#define F1(C) _Bool func1_##C(TYPE x) { return x <= C; } +#define F2(C) _Bool func2_##C(TYPE x) { return ((x >> CTZ (C+ONE)) == 0); } +#define F3(C) _Bool func3_##C(TYPE x) { return ((x / (C+ONE)) == 0); } + +#define F(C) F1(C) F2(C) F3(C) + +F (0x1U) +F (0x3U) +F (0x7U) +F (0xfU) +F (0x1fU) +F (0x3fU) +F (0x7fU) +F (0xffU) +F (0x1ffU) +F (0x3ffU) +F (0x7ffU) +F (0xfffU) +F (0x1fffU) +F (0x3fffU) +F (0x7fffU) +F (0xffffU) +F (0x1ffffU) +F (0x3ffffU) +F (0x7ffffU) +F (0xfffffU) +F (0x1fffffU) +F (0x3fffffU) +F (0x7fffffU) +F (0xffffffU) +F (0x1ffffffU) +F (0x3ffffffU) +F (0x7ffffffU) +F (0xfffffffU) +F (0x1fffffffU) +F (0x3fffffffU) +F (0x7fffffffU) +#if __riscv_xlen == 64 +F (0xffffffffUL) +F (0x1ffffffffUL) +F (0x3ffffffffUL) +F (0x7ffffffffUL) +F (0xfffffffffUL) +F (0x1fffffffffUL) +F (0x3fffffffffUL) +F (0x7fffffffffUL) +F (0xffffffffffUL) +F (0x1ffffffffffUL) +F (0x3ffffffffffUL) +F (0x7ffffffffffUL) +F (0xfffffffffffUL) +F (0x1fffffffffffUL) +F (0x3fffffffffffUL) +F (0x7fffffffffffUL) +F (0xffffffffffffUL) +F (0x1ffffffffffffUL) +F (0x3ffffffffffffUL) +F (0x7ffffffffffffUL) +F (0xfffffffffffffUL) +F (0x1fffffffffffffUL) +F (0x3fffffffffffffUL) +F (0x7fffffffffffffUL) +F (0xffffffffffffffUL) +F (0x1ffffffffffffffUL) +F (0x3ffffffffffffffUL) +F (0x7ffffffffffffffUL) +F (0xfffffffffffffffUL) +F (0x1fffffffffffffffUL) +F (0x3fffffffffffffffUL) +F (0x7fffffffffffffffUL) +#endif + +/* These represent current state. They are not optimal as some of the cases + where we shift are better implemented by loading 2^n constant and using + sltu as the lui has no incoming data dependencies. */ +/* { dg-final { scan-assembler-times "\tsltiu" 30 { target { rv64 } } } } */ +/* { dg-final { scan-assembler-times "\tnot" 3 { target { rv64 } } } } */ +/* { dg-final { scan-assembler-times "\tsrli" 121 { target { rv64 } } } } */ +/* { dg-final { scan-assembler-times "\tsltu" 38 { target { rv64 } } } } */ +/* { dg-final { scan-assembler-times "\tseqz" 118 { target { rv64 } } } } */ +/* { dg-final { scan-assembler-times "\tli" 38 { target { rv64 } } } } */ + +/* { dg-final { scan-assembler-times "\tsltiu" 30 { target { rv32 } } } } */ +/* { dg-final { scan-assembler-times "\tnot" 3 { target { rv32 } } } } */ +/* { dg-final { scan-assembler-times "\tsrli" 25 { target { rv32 } } } } */ +/* { dg-final { scan-assembler-times "\tsltu" 38 { target { rv32 } } } } */ +/* { dg-final { scan-assembler-times "\tseqz" 22 { target { rv32 } } } } */ +/* { dg-final { scan-assembler-times "\tli" 38 { target { rv32 } } } } */ diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_5.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_5.f90 new file mode 100644 index 0000000..7415eed --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_5.f90 @@ -0,0 +1,63 @@ +! { dg-do run } +! { dg-additional-options "-Wa,--noexecstack" { target { ! *-*-darwin* } } } +! { dg-additional-options "-Wl,-z,noexecstack" { target { ! *-*-darwin* } } } +! +! PR fortran/121628 +! Test deep copy of recursive allocatable array components with multi-level +! nesting and repeated circular assignments. This test ensures: +! 1. Deep copy works correctly for grandchildren (multi-level recursion) +! 2. Repeated circular assignments don't cause memory corruption/double-free +! 3. No trampolines are generated (verified by noexecstack flags) +! +! Contributed by Christopher Albert <albert@tugraz.at> +! and Harald Anlauf <anlauf@gcc.gnu.org> +! +program alloc_comp_deep_copy_5 + implicit none + + type :: nested_t + character(len=10) :: name + type(nested_t), allocatable :: children(:) + end type nested_t + + type(nested_t) :: a, b + + ! Build a tree with grandchildren + b%name = "root" + allocate (b%children(2)) + b%children(1)%name = "child1" + b%children(2)%name = "child2" + allocate (b%children(1)%children(1)) + b%children(1)%children(1)%name = "grandchild" + + ! Test 1: Initial assignment + a = b + if (.not. allocated(a%children)) stop 1 + if (.not. allocated(a%children(1)%children)) stop 2 + if (a%children(1)%children(1)%name /= "grandchild") stop 3 + + ! Verify deep copy by modifying a + a%children(1)%children(1)%name = "modified" + if (b%children(1)%children(1)%name /= "grandchild") stop 4 + if (a%children(1)%children(1)%name /= "modified") stop 5 + + ! Test 2: Circular assignment b=a (should not corrupt memory) + b = a + if (.not. allocated(a%children)) stop 6 + if (.not. allocated(a%children(1)%children)) stop 7 + if (.not. allocated(b%children)) stop 8 + if (.not. allocated(b%children(1)%children)) stop 9 + + ! Test 3: Circular assignment a=b (stress test) + a = b + if (.not. allocated(a%children)) stop 10 + if (.not. allocated(a%children(1)%children)) stop 11 + + ! Test 4: Another circular assignment (triggered double-free in buggy code) + b = a + if (.not. allocated(b%children)) stop 12 + if (.not. allocated(b%children(1)%children)) stop 13 + + ! Verify final state + if (b%children(1)%children(1)%name /= "modified") stop 14 +end program alloc_comp_deep_copy_5 diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_6.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_6.f90 new file mode 100644 index 0000000..b243a89 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/alloc_comp_deep_copy_6.f90 @@ -0,0 +1,75 @@ +! { dg-do run } +! { dg-additional-options "-Wa,--noexecstack" { target { ! *-*-darwin* } } } +! { dg-additional-options "-Wl,-z,noexecstack" { target { ! *-*-darwin* } } } +! +! PR fortran/121628 +! Test deep copy of recursive allocatable components with both data arrays +! and recursive children. This is a comprehensive test combining: +! 1. Allocatable data arrays (values) +! 2. Recursive allocatable arrays (children) +! 3. Multi-level tree structure +! 4. Complete data integrity verification after deep copy +! 5. No trampolines (noexecstack flags) +! +! Contributed by Christopher Albert <albert@tugraz.at> +! +program alloc_comp_deep_copy_6 + use, intrinsic :: iso_fortran_env, only: dp => real64 + implicit none + + type :: nested_t + real(dp), allocatable :: values(:) + type(nested_t), allocatable :: children(:) + end type nested_t + + type(nested_t) :: a, b + + ! Build nested structure with both values and children + allocate (b%values(3)) + b%values = [1.0_dp, 2.0_dp, 3.0_dp] + + allocate (b%children(2)) + allocate (b%children(1)%values(2)) + b%children(1)%values = [4.0_dp, 5.0_dp] + + allocate (b%children(2)%values(1)) + b%children(2)%values = [6.0_dp] + + ! Deeper nesting + allocate (b%children(1)%children(1)) + allocate (b%children(1)%children(1)%values(2)) + b%children(1)%children(1)%values = [7.0_dp, 8.0_dp] + + ! Deep copy + a = b + + ! Verify allocation status + if (.not. allocated(a%values)) stop 1 + if (.not. allocated(a%children)) stop 2 + if (.not. allocated(a%children(1)%values)) stop 3 + if (.not. allocated(a%children(2)%values)) stop 4 + if (.not. allocated(a%children(1)%children)) stop 5 + if (.not. allocated(a%children(1)%children(1)%values)) stop 6 + + ! Verify data integrity + if (any(a%values /= [1.0_dp, 2.0_dp, 3.0_dp])) stop 7 + if (any(a%children(1)%values /= [4.0_dp, 5.0_dp])) stop 8 + if (any(a%children(2)%values /= [6.0_dp])) stop 9 + if (any(a%children(1)%children(1)%values /= [7.0_dp, 8.0_dp])) stop 10 + + ! Verify deep copy: modify a and ensure b is unchanged + a%values(1) = -1.0_dp + a%children(1)%values(1) = -2.0_dp + a%children(2)%values(1) = -3.0_dp + a%children(1)%children(1)%values(1) = -4.0_dp + + if (any(b%values /= [1.0_dp, 2.0_dp, 3.0_dp])) stop 11 + if (any(b%children(1)%values /= [4.0_dp, 5.0_dp])) stop 12 + if (any(b%children(2)%values /= [6.0_dp])) stop 13 + if (any(b%children(1)%children(1)%values /= [7.0_dp, 8.0_dp])) stop 14 + + if (any(a%values /= [-1.0_dp, 2.0_dp, 3.0_dp])) stop 15 + if (any(a%children(1)%values /= [-2.0_dp, 5.0_dp])) stop 16 + if (any(a%children(2)%values /= [-3.0_dp])) stop 17 + if (any(a%children(1)%children(1)%values /= [-4.0_dp, 8.0_dp])) stop 18 +end program alloc_comp_deep_copy_6 diff --git a/gcc/testsuite/gfortran.dg/array_memcpy_2.f90 b/gcc/testsuite/gfortran.dg/array_memcpy_2.f90 index 5f54bf1..a95908c 100644 --- a/gcc/testsuite/gfortran.dg/array_memcpy_2.f90 +++ b/gcc/testsuite/gfortran.dg/array_memcpy_2.f90 @@ -1,9 +1,12 @@ ! This checks that the "z = y" assignment is not considered copyable, as the ! array is of a derived type containing allocatable components. Hence, we -! we should expand the scalarized loop, which contains *two* memcpy calls. +! we should expand the scalarized loop, which contains *two* memcpy calls +! for the assignment itself, plus one for initialization. ! { dg-do compile } ! { dg-options "-O2 -fdump-tree-original" } - +! +! PR 121628 +! type :: a integer, allocatable :: i(:) end type a @@ -13,7 +16,14 @@ end type b type(b) :: y(2), z(2) + integer :: j + + do j = 1, 2 + allocate(y(j)%at(1)) + allocate(y(j)%at(1)%i(1)) + y(j)%at(1)%i(1) = j + end do z = y end -! { dg-final { scan-tree-dump-times "memcpy" 2 "original" } } +! { dg-final { scan-tree-dump-times "__builtin_memcpy" 4 "original" } } diff --git a/gcc/testsuite/gfortran.dg/gomp/pr122369-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pr122369-1.f90 new file mode 100644 index 0000000..bf4cbd5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr122369-1.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +! { dg-additional-options "-Wunused-label" } + +! Check that a format label referenced in the first statement past a +! metadirective body is bound to the outer region. + +!$omp metadirective when(user={condition(.true.)}: target teams & +!$omp& distribute parallel do) + DO JCHECK = 1, MNMIN + END DO + WRITE(6,366) PCHECK, UCHECK, VCHECK + 366 FORMAT(/, ' Vcheck = ',E12.4,/) + END PROGRAM diff --git a/gcc/testsuite/gfortran.dg/gomp/pr122369-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pr122369-2.f90 new file mode 100644 index 0000000..041d790 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr122369-2.f90 @@ -0,0 +1,37 @@ +! { dg-do compile } +! { dg-additional-options "-Wunused-label" } + +! Check that a statement label that ends a loop in the first statement past a +! metadirective body is bound to the outer region. + +implicit none +integer :: i, j +logical :: cond1, cond2 +integer :: A(0:10,0:5), B(0:10,0:5) + +cond1 = .true. +cond2 = .true. + +!$omp metadirective when(user={condition(cond1)} : parallel do collapse(2)) + do 50 j = 0, 5 +!$omp metadirective when(user={condition(.false.)} : simd) + do 51 i = 0, 10 + A(i,j) = i*10 + j + 51 continue + 50 continue + + do 55 i = 0, 5 + 55 continue + +!$omp begin metadirective when(user={condition(cond2)} : parallel do collapse(2)) + do 60 j = 0, 5 +!$omp metadirective when(user={condition(.false.)} : simd) + do 61 i = 0, 10 + B(i,j) = i*10 + j + 61 continue + 60 continue +!$omp end metadirective + + do 70 j = 0, 5 + 70 continue +end diff --git a/gcc/testsuite/gfortran.dg/gomp/pr122369-3.f90 b/gcc/testsuite/gfortran.dg/gomp/pr122369-3.f90 new file mode 100644 index 0000000..61225db --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr122369-3.f90 @@ -0,0 +1,23 @@ +! { dg-do compile } +! { dg-additional-options "-Wunused-label" } + +! Check that a statement label defined in the first statement past a +! metadirective body is bound to the outer region. + + +integer :: cnt, x + +cnt = 0 +!$omp begin metadirective when(user={condition(cnt > 0)} : parallel) + x = 5 +!$omp end metadirective +1234 format("Hello") +write(*,1234) + +!$omp begin metadirective when(user={condition(x > 0)} : parallel) + x = 5 +!$omp end metadirective +4567 print *, 'hello', cnt +cnt = cnt + 1 +if (cnt < 2) goto 4567 +end diff --git a/gcc/testsuite/gfortran.dg/gomp/pr122369-4.f90 b/gcc/testsuite/gfortran.dg/gomp/pr122369-4.f90 new file mode 100644 index 0000000..ff5b683 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr122369-4.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } +! { dg-additional-options "-Wunused-label" } + +! Check that a format label defined in the first statement after a nested +! metadirective body can be referenced correctly. + +integer :: cnt, x +cnt = 0 +!$omp begin metadirective when(user={condition(cnt > 0)} : parallel) + !$omp begin metadirective when(user={condition(cnt > 0)} : parallel) + x = 5 + !$omp end metadirective + 1234 format("Hello") + write(*,1234) +!$omp end metadirective +end diff --git a/gcc/testsuite/gfortran.dg/gomp/pr122508-1.f90 b/gcc/testsuite/gfortran.dg/gomp/pr122508-1.f90 new file mode 100644 index 0000000..c64a864 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr122508-1.f90 @@ -0,0 +1,17 @@ +! { dg-do compile } +! { dg-additional-options "-Wunused-label" } + +! Check that a format label defined outside a metadirective body can be +! referenced correctly inside the metadirective body. + +implicit none +integer :: cnt +1345 format("The count is ", g0) + +cnt = 0 +write(*,1345) cnt + +!$omp begin metadirective when(user={condition(cnt > 0)} : parallel) + write(*,1345) cnt +!$omp end metadirective +end diff --git a/gcc/testsuite/gfortran.dg/gomp/pr122508-2.f90 b/gcc/testsuite/gfortran.dg/gomp/pr122508-2.f90 new file mode 100644 index 0000000..4528711 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr122508-2.f90 @@ -0,0 +1,22 @@ +! { dg-do compile } + +! Check that redefining labels across metadirective regions triggers a +! diagnostic. + +implicit none +integer :: cnt +1345 format("The count is ", g0) + +cnt = 0 +write(*,1345) cnt + +!$omp begin metadirective when(user={condition(cnt > 0)} : parallel) + 6789 format("The count is ", g0) + !$omp begin metadirective when(user={condition(cnt > 0)} : parallel) + 1345 print *, 'nested' ! { dg-error "Label 1345 at .1. already referenced as a format label" } + 6789 print *, 'world' + !$omp end metadirective + write(*,1345) cnt ! { dg-error "Label 1345 at .1. previously used as branch target" } + write(*,6789) cnt ! { dg-error "Label 6789 at .1. previously used as branch target" } +!$omp end metadirective +end diff --git a/gcc/testsuite/gfortran.dg/gomp/pr122570.f b/gcc/testsuite/gfortran.dg/gomp/pr122570.f new file mode 100644 index 0000000..9897cc6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/gomp/pr122570.f @@ -0,0 +1,29 @@ +! { dg-do compile } +! { dg-additional-options "-Wall" } + +! PR fortran/122570 + + SUBROUTINE INITAL + implicit none (type, external) + integer :: j, n + n = 5 +!$omp metadirective & +!$omp& when(user={condition(.true.)}: target teams & +!$omp& distribute parallel do) & +!$omp& when(user={condition(.false.)}: target teams & +!$omp& distribute parallel do) + DO J=1,N + END DO + END SUBROUTINE + + SUBROUTINE CALC3 + implicit none (type, external) + integer :: i, m + m = 99 +!$omp metadirective +!$omp& when(user={condition(.false.)}: +!$omp& simd) + DO 301 I=1,M + 301 CONTINUE + 300 CONTINUE ! { dg-warning "Label 300 at .1. defined but not used \\\[-Wunused-label\\\]" } + END SUBROUTINE diff --git a/gcc/testsuite/gfortran.dg/pdt_66.f03 b/gcc/testsuite/gfortran.dg/pdt_66.f03 new file mode 100644 index 0000000..269f6b4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_66.f03 @@ -0,0 +1,54 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! Check the fix for PR122501. +! +! Contributed by Damian Rouson <damian@archaeologic.codes> +! +module tensor_m + implicit none + + type tensor_t(k) + integer, kind :: k = kind(1.) + real(k), allocatable, private :: values_(:) + contains + procedure default_real_values + end type + + interface tensor_t + type(tensor_t) module function construct_default_real(values) + implicit none + real values(:) + end function + end interface + + interface + module function default_real_values(self) result(tensor_values) + implicit none + class(tensor_t) self + real, allocatable :: tensor_values(:) + end function + end interface +end module + + use tensor_m + implicit none +contains + function copy(tensor) + type(tensor_t) tensor, copy, norm_copy + associate(tensor_values => tensor%default_real_values()) + +! This gave: "Component ‘values_’ at (1) is a PRIVATE component of ‘tensor_t’" + copy = tensor_t(tensor_values) + + end associate + +! Make sure that the fix really works :-) + associate(f => tensor%default_real_values()) + associate(tensor_values => tensor%default_real_values()) + norm_copy = tensor_t(tensor_values/maxval(f)) + end associate + end associate + end function +end +! { dg-final { scan-tree-dump-times "default_real_values" 3 "original" } } diff --git a/gcc/testsuite/gfortran.dg/pdt_67.f03 b/gcc/testsuite/gfortran.dg/pdt_67.f03 new file mode 100644 index 0000000..b59d201 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_67.f03 @@ -0,0 +1,36 @@ +! { dg-do compile } +! +! Check the fix for PR122524. +! +! Contributed by Damian Rouson <damian@archaeologic.codes> +! +module tensor_map_m + implicit none + + type tensor_t(k) + integer, kind :: k = kind(1.) + real(k), allocatable :: values_(:) + end type + + interface tensor_t + module function tensor(values) + implicit none + double precision values(:) + type(tensor_t(kind(0D0))) tensor + end function + end interface + + type tensor_map_t(k) + integer, kind :: k = kind(1.) + real(k) slope_ + end type + +contains + function unnormalized_tensor(self, tensor) + type(tensor_map_t(kind(0D0))) self + type(tensor_t(kind(0D0))) tensor, unnormalized_tensor + associate(unnormalized_values => tensor%values_*self%slope_) + unnormalized_tensor = tensor_t(unnormalized_values) ! Caused an ICE. + end associate + end function +end module diff --git a/gcc/testsuite/gfortran.dg/pdt_68.f03 b/gcc/testsuite/gfortran.dg/pdt_68.f03 new file mode 100644 index 0000000..b3493b1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_68.f03 @@ -0,0 +1,34 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! Check the fix for PR122566. +! +! Contributed by Damian Rouson <damian@archaeologic.codes> +! +module double_precision_file_m + implicit none + + type file_t + integer :: i + end type + + type, extends(file_t) :: double_precision_file_t + end type + + type, extends(double_precision_file_t) :: training_configuration_t(m) + integer, kind :: m = kind(1.) + end type + +contains + pure module function training_configuration() + type(training_configuration_t) training_configuration + training_configuration%file_t = file_t(42) ! Needed parent type to be introduced explicitly + end function +end module + + use double_precision_file_m + type(training_configuration_t) :: x + x = training_configuration () + if (x%i /= 42) stop 1 +end +! { dg-final { scan-tree-dump-times "double_precision_file_t.file_t" 2 "original" } } diff --git a/gcc/testsuite/gfortran.dg/pr122513-2.f90 b/gcc/testsuite/gfortran.dg/pr122513-2.f90 new file mode 100644 index 0000000..3f6c5c4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr122513-2.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } + +! PR fortran/122513 + +! The error is not really new but seems to be untested +! before. The example is from the mentioned PR. + +program test + implicit none + integer :: i + do concurrent (i=1:2) default (none) local(i) ! { dg-error "Index variable 'i' at .1. cannot be specified in a locality-spec" } + block + integer, dimension(2,3), parameter :: & + ii = reshape((/ 1,2,3,4,5,6 /), (/2, 3/)) + print*,ii(i,:) + end block + end do +end program test diff --git a/gcc/testsuite/gnat.dg/prefix3.adb b/gcc/testsuite/gnat.dg/prefix3.adb new file mode 100644 index 0000000..904cc03 --- /dev/null +++ b/gcc/testsuite/gnat.dg/prefix3.adb @@ -0,0 +1,8 @@ +-- { dg-do compile } + +with Prefix3_Pkg; + +procedure Prefix3 is +begin + Prefix3_Pkg.Handler.Log ("Hello"); +end; diff --git a/gcc/testsuite/gnat.dg/prefix3_pkg.adb b/gcc/testsuite/gnat.dg/prefix3_pkg.adb new file mode 100644 index 0000000..3c1e7b5 --- /dev/null +++ b/gcc/testsuite/gnat.dg/prefix3_pkg.adb @@ -0,0 +1,16 @@ +package body Prefix3_Pkg is + + My_Handler : aliased Logging := (Output => Ada.Text_IO.Current_Output); + + My_Generic_Handler : Logging_Class := My_Handler'Access; + + procedure Log (Handler : Logging; Msg : String) is + begin + Ada.Text_IO.Put_Line (Handler.Output.all, Msg); + end Log; + + function Handler return Logging_Class is (My_Generic_Handler); + + procedure Handler (To : Logging_Class) is null; + +end Prefix3_Pkg; diff --git a/gcc/testsuite/gnat.dg/prefix3_pkg.ads b/gcc/testsuite/gnat.dg/prefix3_pkg.ads new file mode 100644 index 0000000..9011748 --- /dev/null +++ b/gcc/testsuite/gnat.dg/prefix3_pkg.ads @@ -0,0 +1,16 @@ +with Ada.Text_IO; + +package Prefix3_Pkg is + + type Logging is tagged record + Output : Ada.Text_IO.File_Access; + end record; + + procedure Log (Handler : Logging; Msg : String); + + type Logging_Class is access all Logging'Class; + + function Handler return Logging_Class; + procedure Handler (To : Logging_Class); + +end Prefix3_Pkg; diff --git a/gcc/testsuite/gnat.dg/protected_subtype1.adb b/gcc/testsuite/gnat.dg/protected_subtype1.adb new file mode 100644 index 0000000..cb003c8 --- /dev/null +++ b/gcc/testsuite/gnat.dg/protected_subtype1.adb @@ -0,0 +1,26 @@ +-- { dg-do compile } + +procedure Protected_Subtype1 is + + protected type Object with Lock_Free => True is + end Object; + + protected body Object is + end Object; + + A : Object; + + subtype Object_Subtype is Object; + + B : Object_Subtype; + + type Rec is record + A : Object; + B : Object_Subtype; + end record; + + C : Rec; + +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/renaming19.adb b/gcc/testsuite/gnat.dg/renaming19.adb new file mode 100644 index 0000000..7cb5365 --- /dev/null +++ b/gcc/testsuite/gnat.dg/renaming19.adb @@ -0,0 +1,24 @@ +-- { dg-do run } + +with Ada.Text_IO; +with Renaming19_Pkg; + +procedure Renaming19 is + + Handler : aliased Renaming19_Pkg.Logging := + (Output => Ada.Text_IO.Current_Output); + + Full_Handler : aliased Renaming19_Pkg.Full_Logging := + (Output => Ada.Text_IO.Current_Output); + + Generic_Handler : access Renaming19_Pkg.Logging'Class := Handler'Access; + + procedure My_Log_3 (Msg : String) renames Generic_Handler.Log; + procedure My_Log_4 (Msg : String; Err : Natural) renames Generic_Handler.Log; + +begin + My_Log_3 ("First"); + Generic_Handler := Full_Handler'Access; + My_Log_3 ("Second"); + My_Log_4 ("Third", 3); +end; diff --git a/gcc/testsuite/gnat.dg/renaming19_pkg.adb b/gcc/testsuite/gnat.dg/renaming19_pkg.adb new file mode 100644 index 0000000..19a87aaa --- /dev/null +++ b/gcc/testsuite/gnat.dg/renaming19_pkg.adb @@ -0,0 +1,18 @@ +package body Renaming19_Pkg is + + procedure Log (Handler : Logging; Msg : String) is + begin + Ada.Text_IO.Put_Line (Handler.Output.all, Msg); + end Log; + + procedure Log (Handler : Logging; Msg : String; Err : Natural) is + begin + Ada.Text_IO.Put_Line (Handler.Output.all, Msg & Err'Image); + end Log; + + procedure Log (Handler : Full_Logging; Msg : String) is + begin + raise Program_Error; + end Log; + +end Renaming19_Pkg; diff --git a/gcc/testsuite/gnat.dg/renaming19_pkg.ads b/gcc/testsuite/gnat.dg/renaming19_pkg.ads new file mode 100644 index 0000000..77c0f61 --- /dev/null +++ b/gcc/testsuite/gnat.dg/renaming19_pkg.ads @@ -0,0 +1,16 @@ +with Ada.Text_IO; + +package Renaming19_Pkg is + + type Logging is tagged record + Output : Ada.Text_IO.File_Access; + end record; + + procedure Log (Handler : Logging; Msg : String); + procedure Log (Handler : Logging; Msg : String; Err : Natural); + + type Full_Logging is new Logging with null record; + + procedure Log (Handler : Full_Logging; Msg : String); + +end Renaming19_Pkg; diff --git a/gcc/testsuite/gnat.dg/specs/discr8.ads b/gcc/testsuite/gnat.dg/specs/discr8.ads new file mode 100644 index 0000000..889d37a --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/discr8.ads @@ -0,0 +1,14 @@ +-- { dg-do compile } + +package Discr8 is + + type T1 (N : Natural) is null record; + + type T2 (N : Natural) is record + C1 : string (1 .. T2.n); -- { dg-error "alone as a direct name" } + C2 : string (1 .. n); + C3 : T1 (T2.n); -- { dg-error "alone as a direct name" } + C4 : T1 (n); + end record; + +end Discr8; diff --git a/gcc/testsuite/gnat.dg/specs/generic_inst9.ads b/gcc/testsuite/gnat.dg/specs/generic_inst9.ads new file mode 100644 index 0000000..d81d16b --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/generic_inst9.ads @@ -0,0 +1,20 @@ +-- { dg-do compile } + +with Generic_Inst9_Pkg1; +with Generic_Inst9_Pkg2.G; + +package Generic_Inst9 is + + type T4 is null record; + type T5 is null record; + + subtype T3 is T5; + + type T4_ptr is access T4; + type T5_ptr is access T5; + + package My_Pkg2 is new Generic_Inst9_Pkg2 (T2 => T4); + package My_G4 is new My_Pkg2.G (T4_ptr); -- { dg-bogus "does not match|abandoned" } + package My_G5 is new My_Pkg2.G (T5_ptr); -- { dg-error "does not match|abandoned" } + +end Generic_Inst9; diff --git a/gcc/testsuite/gnat.dg/specs/generic_inst9_pkg1.ads b/gcc/testsuite/gnat.dg/specs/generic_inst9_pkg1.ads new file mode 100644 index 0000000..6c7b2a3 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/generic_inst9_pkg1.ads @@ -0,0 +1,5 @@ +generic + type T1 is private; +package Generic_Inst9_Pkg1 is + subtype T3 is T1; +end Generic_Inst9_Pkg1; diff --git a/gcc/testsuite/gnat.dg/specs/generic_inst9_pkg2-g.ads b/gcc/testsuite/gnat.dg/specs/generic_inst9_pkg2-g.ads new file mode 100644 index 0000000..5118298 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/generic_inst9_pkg2-g.ads @@ -0,0 +1,4 @@ +generic + type T2 is access the_pak1.T3; +package Generic_Inst9_Pkg2.G is +end Generic_Inst9_Pkg2.G; diff --git a/gcc/testsuite/gnat.dg/specs/generic_inst9_pkg2.ads b/gcc/testsuite/gnat.dg/specs/generic_inst9_pkg2.ads new file mode 100644 index 0000000..53a9dee --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/generic_inst9_pkg2.ads @@ -0,0 +1,7 @@ +with Generic_Inst9_Pkg1; + +generic + type T2 is private; +package Generic_Inst9_Pkg2 is + package the_pak1 is new Generic_Inst9_Pkg1 (T1 => T2); +end Generic_Inst9_Pkg2; diff --git a/gcc/testsuite/lib/lto.exp b/gcc/testsuite/lib/lto.exp index 9231e85..a35a3fc 100644 --- a/gcc/testsuite/lib/lto.exp +++ b/gcc/testsuite/lib/lto.exp @@ -309,6 +309,43 @@ proc lto-obj { source dest optall optfile optstr xfaildata } { ${tool}_check_compile "$testcase $dest assemble" $optstr $dest $comp_output } +proc lto-build-archive { testname objlist dest } { + global testcase + global tool + global GCC_UNDER_TEST + + upvar dg-messages-by-file dg-messages-by-file + + verbose "lto-build-archive" 2 + file_on_host delete $dest + + # Check that all of the objects were built successfully. + foreach obj [split $objlist] { + if ![file_on_host exists $obj] then { + unresolved "$testcase $testname build-archive" + return + } + } + + # Hack up the gcc-ar command from $GCC_UNDER_TEST. + set ar_cmd [file dirname [lindex $GCC_UNDER_TEST 0]] + set ar_cmd "$ar_cmd/gcc-ar [lrange $GCC_UNDER_TEST 1 end]" + set ar_output [remote_exec host "$ar_cmd rcs $dest $objlist"] + set retval [lindex $ar_output 0] + set retmsg [lindex $ar_output 1] + + # If any message remains, we fail. Don't bother overriding tool since + # we're not really looking to match any specific error or warning patterns + # here. + if ![string match "0" $retval] then { + ${tool}_fail $testcase "ar returned $retval: $retmsg" + return 0 + } else { + ${tool}_pass $testcase "archive" + return 0 + } +} + # lto-link-and-maybe-run -- link the object files and run the executable # if compile_type is set to "run" # @@ -379,7 +416,8 @@ proc lto-link-and-maybe-run { testname objlist dest optall optfile optstr } { } # Return if we only needed to link. - if { ![string compare "link" $compile_type] } { + if { ![string compare "link" $compile_type] \ + || ![string compare "ar-link" $compile_type] } { return } @@ -510,6 +548,8 @@ proc lto-get-options-main { src } { set compile_type "run" } elseif { ![string compare "link" $dgdo] } { set compile_type "link" + } elseif { ![string compare "ar-link" $dgdo] } { + set compile_type "ar-link" } else { warning "lto.exp does not support dg-lto-do $dgdo" } @@ -691,6 +731,12 @@ proc lto-execute-1 { src1 sid } { # Get the base name of this test, for use in messages. set testcase [lindex ${src_list} 0] + # The test needs to build all but the main file into an archive and then + # link them all together. + if { ![string compare "ar-link" $compile_type] } { + set arname "${sid}_${base}.a" + } + # Remove the $srcdir and $tmpdir prefixes from $src1. (It would # be possible to use "regsub" here, if we were careful to escape # all regular expression characters in $srcdir and $tmpdir, but @@ -755,8 +801,24 @@ proc lto-execute-1 { src1 sid } { incr i } + # Bundle all but the main file into an archive. Update objlist to only + # have the archive and the last file. + if { ![string compare "ar-link" $compile_type] } { + set mainsrc [lindex $obj_list 0] + set obj_list [lrange $obj_list 1 end] + lto-build-archive \ + "[lindex $obj_list 1]-[lindex $obj_list end]" \ + $obj_list $arname + + set obj_list "" + lappend obj_list $mainsrc + lappend obj_list $arname + set num_srcs 2 + } + # Link (using the compiler under test), run, and clean up tests. if { ![string compare "run" $compile_type] \ + || ![string compare "ar-link" $compile_type] \ || ![string compare "link" $compile_type] } { # Filter out any link options we were asked to suppress. @@ -772,6 +834,10 @@ proc lto-execute-1 { src1 sid } { "[lindex $obj_list 0]-[lindex $obj_list end]" \ $obj_list $execname $filtered ${dg-extra-ld-options} \ $filtered + + if (![string compare "ar-link" $compile_type]) { + file_on_host delete $arname + } } @@ -818,6 +884,7 @@ proc lto-execute-1 { src1 sid } { unset testname_with_flags if { ![string compare "run" $compile_type] \ + || ![string compare "ar-link" $compile_type] \ || ![string compare "link" $compile_type] } { file_on_host delete $execname } diff --git a/gcc/testsuite/lib/target-supports.exp b/gcc/testsuite/lib/target-supports.exp index f90cd26..67f1a3c 100644 --- a/gcc/testsuite/lib/target-supports.exp +++ b/gcc/testsuite/lib/target-supports.exp @@ -5169,18 +5169,39 @@ proc check_effective_target_arm_vfp3_ok { } { # Return 1 if this is an ARM target supporting -mfpu=fp-armv8 # -mfloat-abi=softfp. -proc check_effective_target_arm_v8_vfp_ok {} { - if { [check_effective_target_arm32] } { - return [check_no_compiler_messages arm_v8_vfp_ok object { - int foo (void) - { - __asm__ volatile ("vrinta.f32.f32 s0, s0"); - return 0; - } - } "-mfpu=fp-armv8 -mfloat-abi=softfp"] - } else { - return 0 +proc check_effective_target_arm_v8_vfp_ok_nocache {} { + global et_arm_v8_vfp_flags + set et_arm_v8_vfp_flags "" + foreach flags { + "" + "-mfloat-abi=softfp" + "-mcpu=unset -march=armv8-a+simd -mfpu=auto" + "-mcpu=unset -march=armv8-a+simd -mfpu=auto -mfloat-abi=softfp" + } { + if { [check_no_compiler_messages_nocache arm_v8_vfp_ok object { + #if __ARM_ARCH < 8 + #error not armv8 or later + #endif + #if __ARM_ARCH_PROFILE == 'M' + #error incompatible profile + #endif + int foo (void) + { + __asm__ volatile ("vrinta.f32.f32 s0, s0"); + return 0; + } + } "$flags"] } { + set et_arm_v8_vfp_flags "$flags" + return 1 + } } + + return 0 +} + +proc check_effective_target_arm_v8_vfp_ok { } { + return [check_cached_effective_target arm_v8_vfp_ok \ + check_effective_target_arm_v8_vfp_ok_nocache] } # Return 1 if this is an ARM target supporting -mfpu=vfp @@ -5455,7 +5476,8 @@ proc add_options_for_arm_v8_vfp { flags } { if { ! [check_effective_target_arm_v8_vfp_ok] } { return "$flags" } - return "$flags -mfpu=fp-armv8 -mfloat-abi=softfp" + global et_arm_v8_vfp_flags + return "$flags $et_arm_v8_vfp_flags" } proc add_options_for_arm_v8_neon { flags } { diff --git a/gcc/tree-core.h b/gcc/tree-core.h index 145e758..33a6a78 100644 --- a/gcc/tree-core.h +++ b/gcc/tree-core.h @@ -1717,6 +1717,10 @@ struct GTY(()) tree_ssa_name { "!POINTER_TYPE_P (TREE_TYPE ((tree)&%1)) : 2"))) info; /* Immediate uses list for this SSA_NAME. */ struct ssa_use_operand_t imm_uses; +#if defined ENABLE_GIMPLE_CHECKING + gimple *GTY((skip(""))) active_iterated_stmt; + unsigned fast_iteration_depth; +#endif }; struct GTY(()) phi_arg_d { diff --git a/gcc/tree-ssa-forwprop.cc b/gcc/tree-ssa-forwprop.cc index 9a993ab..ae7f0e7 100644 --- a/gcc/tree-ssa-forwprop.cc +++ b/gcc/tree-ssa-forwprop.cc @@ -925,12 +925,10 @@ forward_propagate_addr_expr_1 (tree name, tree def_rhs, static bool forward_propagate_addr_expr (tree name, tree rhs, bool parent_single_use_p) { - imm_use_iterator iter; - gimple *use_stmt; bool all = true; bool single_use_p = parent_single_use_p && has_single_use (name); - FOR_EACH_IMM_USE_STMT (use_stmt, iter, name) + for (gimple *use_stmt : gather_imm_use_stmts (name)) { bool result; tree use_rhs; @@ -3809,13 +3807,16 @@ simplify_vector_constructor (gimple_stmt_iterator *gsi) bool maybe_blend[2] = { true, true }; tree one_constant = NULL_TREE; tree one_nonconstant = NULL_TREE; + tree subelt; auto_vec<tree> constants; constants.safe_grow_cleared (nelts, true); auto_vec<std::pair<unsigned, unsigned>, 64> elts; + unsigned int tsubelts = 0; FOR_EACH_VEC_SAFE_ELT (CONSTRUCTOR_ELTS (op), i, elt) { tree ref, op1; - unsigned int elem; + unsigned int elem, src_elem_size; + unsigned HOST_WIDE_INT nsubelts = 1; if (i >= nelts) return false; @@ -3826,10 +3827,16 @@ simplify_vector_constructor (gimple_stmt_iterator *gsi) if (op1 && TREE_CODE ((ref = TREE_OPERAND (op1, 0))) == SSA_NAME && VECTOR_TYPE_P (TREE_TYPE (ref)) - && useless_type_conversion_p (TREE_TYPE (op1), + && (useless_type_conversion_p (TREE_TYPE (op1), TREE_TYPE (TREE_TYPE (ref))) - && constant_multiple_p (bit_field_offset (op1), - bit_field_size (op1), &elem) + || (VECTOR_TYPE_P (TREE_TYPE (op1)) + && useless_type_conversion_p (TREE_TYPE (TREE_TYPE (op1)), + TREE_TYPE (TREE_TYPE (ref))) + && TYPE_VECTOR_SUBPARTS (TREE_TYPE (op1)) + .is_constant (&nsubelts))) + && constant_multiple_p (bit_field_size (op1), nsubelts, + &src_elem_size) + && constant_multiple_p (bit_field_offset (op1), src_elem_size, &elem) && TYPE_VECTOR_SUBPARTS (TREE_TYPE (ref)).is_constant (&refnelts)) { unsigned int j; @@ -3853,7 +3860,9 @@ simplify_vector_constructor (gimple_stmt_iterator *gsi) maybe_ident = false; if (elem != i) maybe_blend[j] = false; - elts.safe_push (std::make_pair (j, elem)); + for (unsigned int k = 0; k < nsubelts; ++k) + elts.safe_push (std::make_pair (j, elem + k)); + tsubelts += nsubelts; continue; } /* Else fallthru. */ @@ -3865,27 +3874,47 @@ simplify_vector_constructor (gimple_stmt_iterator *gsi) && orig[1] != error_mark_node) return false; orig[1] = error_mark_node; + if (VECTOR_TYPE_P (TREE_TYPE (elt->value)) + && !TYPE_VECTOR_SUBPARTS (TREE_TYPE (elt->value)) + .is_constant (&nsubelts)) + return false; if (CONSTANT_CLASS_P (elt->value)) { if (one_nonconstant) return false; if (!one_constant) - one_constant = elt->value; - constants[i] = elt->value; + one_constant = TREE_CODE (elt->value) == VECTOR_CST + ? VECTOR_CST_ELT (elt->value, 0) + : elt->value; + if (TREE_CODE (elt->value) == VECTOR_CST) + { + for (unsigned int k = 0; k < nsubelts; k++) + constants[tsubelts + k] = VECTOR_CST_ELT (elt->value, k); + } + else + constants[tsubelts] = elt->value; } else { if (one_constant) return false; + subelt = VECTOR_TYPE_P (TREE_TYPE (elt->value)) + ? ssa_uniform_vector_p (elt->value) + : elt->value; + if (!subelt) + return false; if (!one_nonconstant) - one_nonconstant = elt->value; - else if (!operand_equal_p (one_nonconstant, elt->value, 0)) + one_nonconstant = subelt; + else if (!operand_equal_p (one_nonconstant, subelt, 0)) return false; } - elts.safe_push (std::make_pair (1, i)); + for (unsigned int k = 0; k < nsubelts; ++k) + elts.safe_push (std::make_pair (1, tsubelts + k)); + tsubelts += nsubelts; maybe_ident = false; } - if (i < nelts) + + if (elts.length () < nelts) return false; if (! orig[0] diff --git a/gcc/tree-ssa-loop-niter.cc b/gcc/tree-ssa-loop-niter.cc index cc76383..5e35a59 100644 --- a/gcc/tree-ssa-loop-niter.cc +++ b/gcc/tree-ssa-loop-niter.cc @@ -1752,16 +1752,23 @@ dump_affine_iv (FILE *file, affine_iv *iv) if (!integer_zerop (iv->step)) fprintf (file, "["); - print_generic_expr (dump_file, iv->base, TDF_SLIM); + print_generic_expr (file, iv->base, TDF_SLIM); if (!integer_zerop (iv->step)) { fprintf (file, ", + , "); - print_generic_expr (dump_file, iv->step, TDF_SLIM); + print_generic_expr (file, iv->step, TDF_SLIM); fprintf (file, "]%s", iv->no_overflow ? "(no_overflow)" : ""); } } +DEBUG_FUNCTION void +debug (affine_iv *iv) +{ + dump_affine_iv (stderr, iv); + fputc ('\n', stderr); +} + /* Determine the number of iterations according to condition (for staying inside loop) which compares two induction variables using comparison operator CODE. The induction variable on left side of the comparison diff --git a/gcc/tree-ssa-operands.cc b/gcc/tree-ssa-operands.cc index a5970ac..c32cb36 100644 --- a/gcc/tree-ssa-operands.cc +++ b/gcc/tree-ssa-operands.cc @@ -1416,3 +1416,23 @@ single_imm_use_1 (const ssa_use_operand_t *head, return single_use; } +/* Gather all stmts SSAVAR is used on, eliminating duplicates. */ + +auto_vec<gimple *, 2> +gather_imm_use_stmts (tree ssavar) +{ + auto_vec<gimple *, 2> stmts; + imm_use_iterator iter; + use_operand_p use_p; + FOR_EACH_IMM_USE_FAST (use_p, iter, ssavar) + { + gimple *use_stmt = USE_STMT (use_p); + if (use_stmt->ilf) + continue; + use_stmt->ilf = 1; + stmts.safe_push (use_stmt); + } + for (gimple *use_stmt : stmts) + use_stmt->ilf = 0; + return stmts; +} diff --git a/gcc/tree-ssanames.cc b/gcc/tree-ssanames.cc index dcf8da5..3d91573 100644 --- a/gcc/tree-ssanames.cc +++ b/gcc/tree-ssanames.cc @@ -406,6 +406,10 @@ make_ssa_name_fn (struct function *fn, tree var, gimple *stmt, SSA_NAME_IN_FREE_LIST (t) = 0; SSA_NAME_IS_DEFAULT_DEF (t) = 0; init_ssa_name_imm_use (t); +#if defined ENABLE_GIMPLE_CHECKING + t->ssa_name.active_iterated_stmt = NULL; + t->ssa_name.fast_iteration_depth = 0; +#endif return t; } diff --git a/gcc/tree-vect-generic.cc b/gcc/tree-vect-generic.cc index b8e6a71..29d97cf 100644 --- a/gcc/tree-vect-generic.cc +++ b/gcc/tree-vect-generic.cc @@ -1619,24 +1619,6 @@ lower_vec_perm (gimple_stmt_iterator *gsi) update_stmt (gsi_stmt (*gsi)); } -/* If OP is a uniform vector return the element it is a splat from. */ - -static tree -ssa_uniform_vector_p (tree op) -{ - if (TREE_CODE (op) == VECTOR_CST - || TREE_CODE (op) == VEC_DUPLICATE_EXPR - || TREE_CODE (op) == CONSTRUCTOR) - return uniform_vector_p (op); - if (TREE_CODE (op) == SSA_NAME) - { - gimple *def_stmt = SSA_NAME_DEF_STMT (op); - if (gimple_assign_single_p (def_stmt)) - return uniform_vector_p (gimple_assign_rhs1 (def_stmt)); - } - return NULL_TREE; -} - /* Return the type that should be used to implement OP on type TYPE. This is TYPE itself if the target can do the operation directly, otherwise it is a scalar type or a smaller vector type. */ diff --git a/gcc/tree.cc b/gcc/tree.cc index 446261a..298784e 100644 --- a/gcc/tree.cc +++ b/gcc/tree.cc @@ -10823,6 +10823,24 @@ uniform_vector_p (const_tree vec) return NULL_TREE; } +/* If OP is a uniform vector return the element it is a splat from. */ + +tree +ssa_uniform_vector_p (tree op) +{ + if (TREE_CODE (op) == VECTOR_CST + || TREE_CODE (op) == VEC_DUPLICATE_EXPR + || TREE_CODE (op) == CONSTRUCTOR) + return uniform_vector_p (op); + if (TREE_CODE (op) == SSA_NAME) + { + gimple *def_stmt = SSA_NAME_DEF_STMT (op); + if (gimple_assign_single_p (def_stmt)) + return uniform_vector_p (gimple_assign_rhs1 (def_stmt)); + } + return NULL_TREE; +} + /* If the argument is INTEGER_CST, return it. If the argument is vector with all elements the same INTEGER_CST, return that INTEGER_CST. Otherwise return NULL_TREE. @@ -5303,6 +5303,10 @@ extern tree vector_cst_elt (const_tree, unsigned int); extern tree uniform_vector_p (const_tree); +/* Same as above, but if VEC is an SSA_NAME, inspect its definition. */ + +extern tree ssa_uniform_vector_p (tree); + /* If the argument is INTEGER_CST, return it. If the argument is vector with all elements the same INTEGER_CST, return that INTEGER_CST. Otherwise return NULL_TREE. */ diff --git a/libbacktrace/elf.c b/libbacktrace/elf.c index 868d0e1..0f14066 100644 --- a/libbacktrace/elf.c +++ b/libbacktrace/elf.c @@ -160,10 +160,10 @@ dl_iterate_phdr (int (*callback) (struct dl_phdr_info *, #undef EI_CLASS #undef EI_DATA #undef EI_VERSION -#undef ELF_MAG0 -#undef ELF_MAG1 -#undef ELF_MAG2 -#undef ELF_MAG3 +#undef ELFMAG0 +#undef ELFMAG1 +#undef ELFMAG2 +#undef ELFMAG3 #undef ELFCLASS32 #undef ELFCLASS64 #undef ELFDATA2LSB diff --git a/libgcobol/charmaps.cc b/libgcobol/charmaps.cc index 349c669..d408465 100644 --- a/libgcobol/charmaps.cc +++ b/libgcobol/charmaps.cc @@ -1376,7 +1376,7 @@ static encodings_t encodings[] = { { false, iconv_UTF_7_e, "UTF-7" }, // Is UTF-8 supported?? "supported" means "recognized by parser_alphabet", // but UTF-8 is not a valid runtime encoding. - { false, iconv_UTF_8_e, "UTF-8" }, + { false, iconv_UTF_8_e, "UTF-8" }, { false, iconv_UTF_16_e, "UTF-16" }, { false, iconv_UTF_16BE_e, "UTF-16BE" }, { false, iconv_UTF_16LE_e, "UTF-16LE" }, @@ -1439,10 +1439,20 @@ cbl_encoding_t __gg__encoding_iconv_type( const char *name ) { static encodings_t *eoencodings = encodings + COUNT_OF(encodings); + char *slashless = strdup(name); + assert(slashless); + char *pslash = strchr(slashless, '/'); + if( pslash ) + { + *pslash = '\0'; + } + auto p = std::find_if( encodings, eoencodings, - [name]( const encodings_t& elem ) { - return strcmp(name, elem.name) == 0; + [slashless]( const encodings_t& elem ) { + return strcasecmp(slashless, elem.name) == 0; } ); + free(slashless); + return p < eoencodings? p->type : no_encoding_e; } @@ -1557,7 +1567,7 @@ __gg__get_charmap(cbl_encoding_t encoding) if( encoding == custom_encoding_e) { - encoding = DEFAULT_CHARMAP_SOURCE; + encoding = DEFAULT_SOURCE_ENCODING; } charmap_t *retval; diff --git a/libgcobol/charmaps.h b/libgcobol/charmaps.h index f35d033..f48c063 100644 --- a/libgcobol/charmaps.h +++ b/libgcobol/charmaps.h @@ -228,13 +228,17 @@ char * __gg__iconverter(cbl_encoding_t from, size_t length, size_t *outlength); -#define DEFAULT_CHARMAP_SOURCE (iconv_CP1252_e) +#define DEFAULT_SOURCE_ENCODING (iconv_CP1252_e) class charmap_t { private: // This is the encoding of this character map cbl_encoding_t m_encoding; + bool m_is_valid; + bool m_is_big_endian; + bool m_has_bom = false; + int m_stride; // Number of bytes between one character and the next enum { @@ -246,32 +250,114 @@ class charmap_t // need be called but once for each ASCII value. std::unordered_map<int, int>m_map_of_encodings; - void determine_sign_type() + public: + explicit charmap_t(cbl_encoding_t e) : m_encoding(e) { - if( mapped_character(ascii_0) & 0x80 ) + // We are constructing a new charmap_t from an arbitrary encoding. We + // need to figure out how wide it is, its endianness, whether or not + // it is EBCDIC-based, and so on. + + // We do that by converting "0" to the target encoding, and we analyze + // what we get back. + + size_t outlength = 0; + const char challenge[] = "0"; + const unsigned char *response = PTRCAST(unsigned char, + __gg__iconverter(DEFAULT_SOURCE_ENCODING, + m_encoding, + challenge, + 1, + &outlength)); + unsigned char char_0 = 0x00; + + m_is_valid = false; + m_has_bom = false; + m_is_big_endian = false; + + if( outlength == 1 ) { - m_numeric_sign_type = sign_type_ebcdic; + m_stride = 1; + // This is our happy place: A single-byte encoded character set. + char_0 = response[0]; } - else + else if( outlength == 2 ) + { + m_stride = 2; + if( response[0] ) + { + char_0 = response[0]; + } + else if( response[1] ) + { + m_is_big_endian = true; + char_0 = response[1]; + } + } + else if( outlength == 4 ) { + // Check for the Byte Order Mark (BOM) + if( response[0] == 0xFF && response[1] == 0xFE ) + { + m_stride = 2; + m_has_bom = true; + char_0 = response[2]; + } + else if( response[0] == 0xFE && response[1] == 0xFF ) + { + m_stride = 2; + m_has_bom = true; + m_is_big_endian = true; + char_0 = response[3]; + } + else if( response[0] ) + { + m_stride = 4; + char_0 = response[0]; + } + else + { + m_stride = 4; + m_is_big_endian = true; + char_0 = response[3]; + } + } + else if( outlength == 8 ) + { + m_stride = 4; + if( response[0] == 0xFF && response[1] == 0xFE ) + { + char_0 = response[4]; + } + else if( response[0] == 0xFE && response[1] == 0xFF ) + { + m_is_big_endian = true; + char_0 = response[7]; + } + } + + // With everything else established, we now check the zero character. + // We know about only 0x30 for ASCII and 0xF0 for EBCDIC. + if( char_0 == 0x30 ) + { + m_is_valid = true; m_numeric_sign_type = sign_type_ascii; } + else if( char_0 == 0xF0 ) + { + m_is_valid = true; + m_numeric_sign_type = sign_type_ebcdic; + } } - public: - explicit charmap_t(cbl_encoding_t e) : m_encoding(e) - { - determine_sign_type(); - } - explicit charmap_t(uint16_t e) : m_encoding(static_cast<cbl_encoding_t>(e)) - { - determine_sign_type(); - } + bool is_valid() const{return m_is_valid ;} + bool is_big_endian() const{return m_is_big_endian;} + bool has_bom() const{return m_has_bom ;} + int stride() const{return m_stride ;} int mapped_character(int ch) { // The assumption is that anybody calling this routine is providing - // a single-byte character in the DEFAULT_CHARMAP_SOURCE encoding. We + // a single-byte character in the DEFAULT_SOURCE_ENCODING encoding. We // return the equivalent character in the m_encoding int retval; std::unordered_map<int, int>::const_iterator it = @@ -284,7 +370,7 @@ class charmap_t { retval = 0; size_t outlength = 0; - const char *mapped = __gg__iconverter(DEFAULT_CHARMAP_SOURCE, + const char *mapped = __gg__iconverter(DEFAULT_SOURCE_ENCODING, m_encoding, PTRCAST(char, &ch), 1, diff --git a/libgcobol/encodings.h b/libgcobol/encodings.h index 51cc6c3..37bcde3 100644 --- a/libgcobol/encodings.h +++ b/libgcobol/encodings.h @@ -1195,6 +1195,11 @@ enum cbl_encoding_t { iconv_YU_e, }; +static inline bool +valid_encoding( cbl_encoding_t enc ) { + return enc <= iconv_YU_e; +} + #define ASCII_e iconv_ASCII_e #define CP1252_e iconv_CP1252_e #define EBCDIC_e iconv_CP1140_e diff --git a/libgcobol/gcobolio.h b/libgcobol/gcobolio.h index 7a1c9ac..14ef069 100644 --- a/libgcobol/gcobolio.h +++ b/libgcobol/gcobolio.h @@ -81,6 +81,7 @@ enum cblc_file_prior_op_t file_op_rewrite, file_op_delete, file_op_close, + file_op_remove, }; /* end implementation details */ diff --git a/libgcobol/gfileio.cc b/libgcobol/gfileio.cc index 16d75b0..7c01f39 100644 --- a/libgcobol/gfileio.cc +++ b/libgcobol/gfileio.cc @@ -191,9 +191,10 @@ handle_errno(cblc_file_t *file, const char *function, const char *msg) static char * -get_filename( const cblc_file_t *file, - int is_quoted) +get_filename( const cblc_file_t *file) { + bool is_quoted = !!(file->flags & file_name_quoted_e); + static size_t fname_size = MINIMUM_ALLOCATION_SIZE; static char *fname = static_cast<char *>(malloc(MINIMUM_ALLOCATION_SIZE)); massert(fname); @@ -1152,6 +1153,80 @@ __io__file_delete(cblc_file_t *file, bool is_random) } static void +__io__file_remove(cblc_file_t *file, char *filename, int is_quoted) + { + // filename is the result of a strdup or malloc. Because both FILE OPEN + // and FILE DELETE can establish or change a name, we free it here and + // replace it. The same is true in FILE DELETE Format 2 + free(file->filename); + file->filename = filename; + file->flags &= ~file_name_quoted_e; + file->flags |= is_quoted ? file_name_quoted_e : file_flag_none_e; + int erc; + + // This code copied from reopen + const char *trimmed_name = get_filename(file); + if( !trimmed_name[0] ) + { + bool all_spaces = true; + for(size_t i=0; i<strlen(file->filename); i++) + { + if( file->filename[i] != ascii_space ) + { + all_spaces = false; + } + break; + } + if( all_spaces ) + { + warnx("Warning: %s specified with a filename that is all spaces", + file->name); + file->io_status = FsNameError; // "31" + goto done; + } + + warnx( "%s(): There is no environment variable named \"%s\"\n", + __func__, + file->filename); + file->io_status = FsNoFile; // "35" + goto done; + } + // trimmed_name is now the file system name of the file to be removed. + + // If the file is open, we flag that with "41" + if( file->file_pointer ) + { + file->io_status = FsIsOpen; // "41" + goto done; + } + + // There's been a lot of buildup. We can now try to remove the file: + errno = 0; + erc = remove(trimmed_name); + if( erc == 0 ) + { + // All is copacetic. There was a file, and now it's gone. + file->io_status = FsSuccess; // "00" + } + else if( errno == ENOENT ) + { + // The file didn't exist. + file->io_status = FsUnavail; // "05" + } + else + { + // We have some other kind of error. Lack of credentials, or whatever. + file->io_status = FsErrno; // + goto done; + } + + file->prior_op = file_op_remove; + done: + file->errnum = errno; + establish_status(file, -1); + } + +static void indexed_file_start( cblc_file_t *file, int relop, int key_number, @@ -4115,7 +4190,7 @@ __gg__file_reopen(cblc_file_t *file, int mode_char) // Stash the mode_char for later analysis during READ and WRITE operations file->mode_char = mode_char; char *trimmed_name; - trimmed_name = get_filename(file, !!(file->flags & file_name_quoted_e)); + trimmed_name = get_filename(file); if( !trimmed_name[0] ) { bool all_spaces = true; @@ -4353,8 +4428,10 @@ __io__file_open(cblc_file_t *file, } else { - // filename is the result of a strdup or malloc. We will free() it at - // file close time. + // filename is the result of a strdup or malloc. Because both FILE OPEN + // and FILE DELETE can establish or change a name, we free it here and + // replace it. The same is true in FILE DELETE Format 2 + free(file->filename); file->filename = filename; file->flags &= ~file_name_quoted_e; file->flags |= is_quoted ? file_name_quoted_e : file_flag_none_e; @@ -4492,6 +4569,9 @@ public: size_t length, bool is_random ); typedef void (delete_t)( cblc_file_t *file, bool is_random ); + typedef void (remove_t)( cblc_file_t *file, + char *filename, + int is_quoted); open_t *Open; close_t *Close; @@ -4500,6 +4580,7 @@ public: write_t *Write; rewrite_t *Rewrite; delete_t *Delete; + remove_t *Remove; gcobol_io_t() : Open(NULL) @@ -4509,15 +4590,17 @@ public: , Write(NULL) , Rewrite(NULL) , Delete(NULL) + , Remove(NULL) {} - gcobol_io_t( open_t *Open, + gcobol_io_t( open_t *Open, close_t *Close, start_t *Start, read_t *Read, write_t *Write, rewrite_t *Rewrite, - delete_t *Delete ) + delete_t *Delete, + remove_t *Remove) : Open(Open) , Close(Close) , Start(Start) @@ -4525,6 +4608,7 @@ public: , Write(Write) , Rewrite(Rewrite) , Delete(Delete) + , Remove(Remove) {} #if FILE_IO_IMPLEMENTED @@ -4552,7 +4636,8 @@ gcobol_fileops() { __io__file_read, __io__file_write, __io__file_rewrite, - __io__file_delete ); + __io__file_delete, + __io__file_remove); } /* @@ -4657,9 +4742,19 @@ extern "C" void __gg__file_delete(cblc_file_t *file, bool is_random) { + // DELETE FILE Format 1 - deletes a record. gcobol_io_t *functions = gcobol_io_funcs(); functions->Delete(file, is_random); } +extern "C" + +void +__gg__file_remove(cblc_file_t *file, char *name, int is_quoted) + { + // DELETE FILE Format 2 - removes a file. + gcobol_io_t *functions = gcobol_io_funcs(); + functions->Remove(file, name, is_quoted); + } /* end interface functions */ diff --git a/libgcobol/intrinsic.cc b/libgcobol/intrinsic.cc index 49dee6e..bb03f62 100644 --- a/libgcobol/intrinsic.cc +++ b/libgcobol/intrinsic.cc @@ -55,7 +55,6 @@ #include "libgcobol.h" #include "charmaps.h" - #pragma GCC diagnostic ignored "-Wformat-truncation" #define JD_OF_1601_01_02 2305812.5 @@ -576,7 +575,7 @@ get_all_time( const cblc_field_t *dest, // needed for the target encoding ctm.day_of_year, ctm.ZZZZ); __gg__convert_encoding(PTRCAST(char, stime), - DEFAULT_CHARMAP_SOURCE, + DEFAULT_SOURCE_ENCODING, dest->encoding); } @@ -810,7 +809,6 @@ ftime_replace(char *dest, const char *src; bool saw_decimal_point = false; bool saw_plus_sign = false; - char decimal_point = __gg__get_decimal_point(); static const int OFFSET_TO_YYYY = 0; static const int OFFSET_TO_MM = 4; static const int OFFSET_TO_DD = 6; @@ -826,18 +824,20 @@ ftime_replace(char *dest, static const int OFFSET_TO_DOY = 34; static const int OFFSET_TO_ZZZZ = 37; - int source_Y = charmap_source->mapped_character(ascii_Y ); - int source_W = charmap_source->mapped_character(ascii_W ); - int source_s = charmap_source->mapped_character(ascii_s ); - int source_m = charmap_source->mapped_character(ascii_m ); - int source_h = charmap_source->mapped_character(ascii_h ); - int source_plus = charmap_source->mapped_character(ascii_plus); - int source_D = charmap_source->mapped_character(ascii_D ); - int source_M = charmap_source->mapped_character(ascii_M ); + unsigned int decimal_point = + charmap_source->mapped_character(__gg__get_decimal_point()); + unsigned int source_Y = charmap_source->mapped_character(ascii_Y ); + unsigned int source_W = charmap_source->mapped_character(ascii_W ); + unsigned int source_s = charmap_source->mapped_character(ascii_s ); + unsigned int source_m = charmap_source->mapped_character(ascii_m ); + unsigned int source_h = charmap_source->mapped_character(ascii_h ); + unsigned int source_plus = charmap_source->mapped_character(ascii_plus); + unsigned int source_D = charmap_source->mapped_character(ascii_D ); + unsigned int source_M = charmap_source->mapped_character(ascii_M ); while( source < source_end && dest < dest_end ) { - char fchar = *source; + unsigned char fchar = *source; if( fchar == source_Y ) { // This can only be a YYYY @@ -847,7 +847,7 @@ ftime_replace(char *dest, const char *p = source; while(p < source_end) { - if( *p++ == source_W ) + if( (unsigned char)*p++ == source_W ) { src = ftime + OFFSET_TO_ZZZZ; } @@ -864,12 +864,12 @@ ftime_replace(char *dest, else if( fchar == source_D ) { // It can be a D, DD or DDD - if( source[2] == source_D ) + if( (unsigned char)source[2] == source_D ) { ncount = 3; src = ftime + OFFSET_TO_DOY; } - else if( source[1] == source_D ) + else if( (unsigned char)source[1] == source_D ) { ncount = 2; src = ftime + OFFSET_TO_DD; @@ -946,7 +946,7 @@ ftime_replace(char *dest, { // This indicates special processing for a variable number of 's' // characters - while(*source == 's' && dest < dest_end) + while((unsigned char)*source == source_s && dest < dest_end) { source += 1; *dest++ = *src++; @@ -1279,7 +1279,7 @@ __gg__current_date(cblc_field_t *dest) char retval[DATE_STRING_BUFFER_SIZE]; timespec_to_string(retval, tp); __gg__convert_encoding(PTRCAST(char, retval), - DEFAULT_CHARMAP_SOURCE, + DEFAULT_SOURCE_ENCODING, dest->encoding); string_to_dest(dest, retval); } @@ -2022,7 +2022,6 @@ __gg__max(cblc_field_t *dest, } } - __gg__adjust_dest_size(dest, best_length); dest->type = FldAlphanumeric; assert(best_location); @@ -2088,12 +2087,12 @@ __gg__lower_case( cblc_field_t *dest, __gg__convert_encoding_length(PTRCAST(char, dest->data), length, from, - DEFAULT_CHARMAP_SOURCE); + DEFAULT_SOURCE_ENCODING); std::transform(dest->data, dest->data + dest_length, dest->data, [](unsigned char c) { return std::tolower(c); }); __gg__convert_encoding_length(PTRCAST(char, dest->data), length, - DEFAULT_CHARMAP_SOURCE, + DEFAULT_SOURCE_ENCODING, to); } @@ -2391,25 +2390,23 @@ numval( cblc_field_t *dest, size_t input_offset, size_t input_size) { - // Returns the one-based character position of a bad character - // returns zero if it is okay + // Returns the one-based character position of a bad character. + // Returns zero if it is okay. + + // This routine works in ASCII space: - const char *p = PTRCAST(char, (input->data + input_offset)); - const char *pend = p + input_size; + size_t nbytes; + const char *p = __gg__iconverter(input->encoding, + DEFAULT_SOURCE_ENCODING, + PTRCAST(char, input->data + input_offset), + input_size, + &nbytes); + const char *pend = p + input_size; int errpos = 0; __int128 retval = 0; int retval_rdigits = 0; - charmap_t *charmap = __gg__get_charmap(input->encoding); - unsigned char decimal_point - = charmap->mapped_character(__gg__get_decimal_point()); - int mapped_0 = charmap->mapped_character(ascii_0); - int mapped_9 = charmap->mapped_character(ascii_9); - int mapped_space = charmap->mapped_character(ascii_space); - int mapped_plus = charmap->mapped_character(ascii_plus); - int mapped_minus = charmap->mapped_character(ascii_minus); - bool saw_digit= false; bool in_fraction = false; bool leading_sign = false; @@ -2437,31 +2434,31 @@ numval( cblc_field_t *dest, case SPACE1: // We tolerate spaces, and expect to end with a sign, digit, // or decimal point: - if( ch == mapped_space ) + if( ch == ascii_space ) { continue; } - if( ch == mapped_plus ) + if( ch == ascii_plus ) { leading_sign = true; state = SPACE2; break; } - if( ch == mapped_minus ) + if( ch == ascii_minus ) { leading_sign = true; is_negative = true; state = SPACE2; break; } - if( ch >= mapped_0 && ch <= mapped_9 ) + if( ch >= ascii_0 && ch <= ascii_9 ) { saw_digit = true; retval = ch & 0xF; state = DIGITS; break; } - if( ch == decimal_point ) + if( ch == __gg__decimal_point ) { in_fraction = true; state = DIGITS; @@ -2473,18 +2470,18 @@ numval( cblc_field_t *dest, case SPACE2: // We tolerate spaces, and expect to end with a digit or decimal point: - if( ch == mapped_space ) + if( ch == ascii_space ) { break; } - if( ch >= mapped_0 && ch <= mapped_9 ) + if( ch >= ascii_0 && ch <= ascii_9 ) { saw_digit = true; retval = ch & 0xF; state = DIGITS; break; } - if( ch == decimal_point ) + if( ch == __gg__decimal_point ) { in_fraction = true; state = DIGITS; @@ -2499,7 +2496,7 @@ numval( cblc_field_t *dest, // end with a space, a sign, "DB" or "CR", or the the end of the string // It's a bit complicated - if( ch >= mapped_0 && ch <= mapped_9 ) + if( ch >= ascii_0 && ch <= ascii_9 ) { saw_digit = true; retval *= 10; @@ -2510,43 +2507,43 @@ numval( cblc_field_t *dest, } break; } - if( ch == decimal_point && in_fraction ) + if( ch == __gg__decimal_point && in_fraction ) { // Only one decimal is allowed goto done; } - if( ch == decimal_point ) + if( ch == __gg__decimal_point ) { in_fraction = true; break; } - if( ch == mapped_space ) + if( ch == ascii_space ) { state = SPACE3; break; } - if( ch == mapped_plus && leading_sign) + if( ch == ascii_plus && leading_sign) { // We are allowed leading or trailing signs, but not both goto done; } - if( ch == mapped_minus && leading_sign) + if( ch == ascii_minus && leading_sign) { // We are allowed leading or trailing signs, but not both goto done; } - if( ch == mapped_plus ) + if( ch == ascii_plus ) { state = SPACE4; break; } - if( ch == mapped_minus ) + if( ch == ascii_minus ) { is_negative = true; state = SPACE4; break; } - if( std::tolower(ch) == 'd' ) + if( std::tolower(ch) == ascii_d ) { if( leading_sign ) { @@ -2554,7 +2551,7 @@ numval( cblc_field_t *dest, } ch = *p++; errpos += 1; - if( p > pend || std::tolower(ch) != 'b' ) + if( p > pend || std::tolower(ch) != ascii_b ) { goto done; } @@ -2562,7 +2559,7 @@ numval( cblc_field_t *dest, state = SPACE4; break; } - if( std::tolower(ch) == 'c' ) + if( std::tolower(ch) == ascii_c ) { if( leading_sign ) { @@ -2570,7 +2567,7 @@ numval( cblc_field_t *dest, } ch = *p++; errpos += 1; - if( p > pend || std::tolower(ch) != 'r' ) + if( p > pend || std::tolower(ch) != ascii_r ) { goto done; } @@ -2584,26 +2581,26 @@ numval( cblc_field_t *dest, case SPACE3: // We tolerate spaces, or we end with a sign: - if( ch == mapped_space ) + if( ch == ascii_space ) { break; } - if( ch == mapped_plus && leading_sign) + if( ch == ascii_plus && leading_sign) { // We are allowed leading or trailing signs, but not both goto done; } - if( ch == mapped_minus && leading_sign) + if( ch == ascii_minus && leading_sign) { // We are allowed leading or trailing signs, but not both goto done; } - if( ch == mapped_plus ) + if( ch == ascii_plus ) { state = SPACE4; break; } - if( ch == mapped_minus ) + if( ch == ascii_minus ) { is_negative = true; state = SPACE4; @@ -2617,7 +2614,7 @@ numval( cblc_field_t *dest, } ch = *p++; errpos += 1; - if( p > pend || std::tolower(ch) != 'b' ) + if( p > pend || std::tolower(ch) != ascii_b ) { goto done; } @@ -2633,7 +2630,7 @@ numval( cblc_field_t *dest, } ch = *p++; errpos += 1; - if( p > pend || std::tolower(ch) != 'r' ) + if( p > pend || std::tolower(ch) != ascii_r ) { goto done; } @@ -2644,7 +2641,7 @@ numval( cblc_field_t *dest, goto done; break; case SPACE4: - if( ch == mapped_space ) + if( ch == ascii_space ) { break; } @@ -2658,7 +2655,7 @@ numval( cblc_field_t *dest, } else if( p == pend ) { - // If we got to the end without seeing adigit, we need to bump the + // If we got to the end without seeing a digit, we need to bump the // error pointer: errpos += 1; } @@ -2696,7 +2693,15 @@ numval_c( cblc_field_t *dest, { size_t errcode = 0; - char *pstart = PTRCAST(char, (src->data+src_offset)); +// char *pstart = PTRCAST(char, (src->data+src_offset)); + size_t nbytes; + const char *converted = __gg__iconverter(src->encoding, + DEFAULT_SOURCE_ENCODING, + PTRCAST(char, src->data+src_offset), + src_size, + &nbytes); + char *pstart = strdup(converted); + massert(pstart); char *pend = pstart + src_size; char *p = pstart; @@ -2704,45 +2709,41 @@ numval_c( cblc_field_t *dest, int sign = 0; int rdigits = 0; int rdigit_bump = 0; - charmap_t *charmap = __gg__get_charmap(src->encoding); - unsigned char decimal_point - = charmap->mapped_character(__gg__get_decimal_point()); - unsigned char decimal_separator - = charmap->mapped_character(__gg__get_decimal_separator()); - int mapped_0 = charmap->mapped_character(ascii_0); - int mapped_9 = charmap->mapped_character(ascii_9); - int mapped_space = charmap->mapped_character(ascii_space); - int mapped_plus = charmap->mapped_character(ascii_plus); - int mapped_minus = charmap->mapped_character(ascii_minus); - int mapped_C = charmap->mapped_character(ascii_C); - int mapped_R = charmap->mapped_character(ascii_R); - int mapped_D = charmap->mapped_character(ascii_D); - int mapped_B = charmap->mapped_character(ascii_B); - int mapped_c = charmap->mapped_character(ascii_c); - int mapped_r = charmap->mapped_character(ascii_r); - int mapped_d = charmap->mapped_character(ascii_d); - int mapped_b = charmap->mapped_character(ascii_b); + unsigned char decimal_point = __gg__decimal_point; + unsigned char decimal_separator = __gg__decimal_separator; + + char *currency_in_ascii; char *currency_start; char *currency_end; if( crcy ) { - currency_start = PTRCAST(char, (crcy->data+crcy_offset)); - currency_end = currency_start + crcy_size; + converted = __gg__iconverter(crcy->encoding, + DEFAULT_SOURCE_ENCODING, + PTRCAST(char, crcy->data+crcy_offset), + crcy_size, + &nbytes); + currency_in_ascii = static_cast<char*>(malloc(nbytes+1)); + massert(currency_in_ascii); + strcpy(currency_in_ascii, converted); } else { - currency_start = __gg__get_default_currency_string(); - currency_end = currency_start + strlen(currency_start); + // This is in ascii + currency_in_ascii = strdup(__gg__get_default_currency_string()); + massert(currency_in_ascii); } + currency_start = currency_in_ascii; + currency_end = currency_start + strlen(currency_start); + char *pcurrency = currency_start; // Trim off spaces from the currency: - while( *pcurrency == mapped_space && pcurrency < currency_end ) + while( *pcurrency == ascii_space && pcurrency < currency_end ) { pcurrency += 1; } - while( *(currency_end-1) == mapped_space && currency_end > currency_start ) + while( *(currency_end-1) == ascii_space && currency_end > currency_start ) { currency_end -= 1; } @@ -2769,12 +2770,12 @@ numval_c( cblc_field_t *dest, { case first_space : // Eat up spaces, if any, and then dispatch on the first non-space: - if( ch != mapped_space ) + if( ch != ascii_space ) { // ch can now be a plus, a minus, a digit, or the first character // of the currency string - if( ch == mapped_plus - || ch == mapped_minus ) + if( ch == ascii_plus + || ch == ascii_minus ) { state = first_sign; // Decrement to pointer in order to pick up the character again @@ -2785,7 +2786,7 @@ numval_c( cblc_field_t *dest, state = currency; p -= 1; } - else if( (ch >= mapped_0 && ch <= mapped_9) + else if( (ch >= ascii_0 && ch <= ascii_9) || ch == decimal_point ) { state = digits; @@ -2805,7 +2806,7 @@ numval_c( cblc_field_t *dest, case first_sign : // We know the character is a plus or a minus: - if( ch == mapped_plus ) + if( ch == ascii_plus ) { sign = 1; state = second_space; @@ -2820,14 +2821,14 @@ numval_c( cblc_field_t *dest, case second_space : // Eat up spaces, if any. This segment has to end with a currency or // a digit: - if( ch != mapped_space ) + if( ch != ascii_space ) { if( ch == *pcurrency ) { state = currency; p -= 1; } - else if( (ch >= mapped_0 && ch <= mapped_9) + else if( (ch >= ascii_0 && ch <= ascii_9) || ch == decimal_point ) { state = digits; @@ -2868,9 +2869,9 @@ numval_c( cblc_field_t *dest, case before_digits : // Eat up spaces, if any. This segment has to end with a digit - if( ch != mapped_space ) + if( ch != ascii_space ) { - if( (ch >= mapped_0 && ch <= mapped_9) + if( (ch >= ascii_0 && ch <= ascii_9) || ch == decimal_point ) { state = digits; @@ -2890,7 +2891,7 @@ numval_c( cblc_field_t *dest, case digits : // The only thing allowed here are digits, decimal points, and // decimal separators - if( ch >= mapped_0 && ch <= mapped_9 ) + if( ch >= ascii_0 && ch <= ascii_9 ) { // We have a digit. rdigits += rdigit_bump; @@ -2923,14 +2924,14 @@ numval_c( cblc_field_t *dest, case after_digits : // after digits, the only valid things are spaces, plus, minus, D, or C - if( ch != charmap->mapped_character(ascii_space) ) + if( ch != ascii_space ) { - if( ch == mapped_plus - || ch == mapped_minus - || ch == mapped_D - || ch == mapped_d - || ch == mapped_C - || ch == mapped_c ) + if( ch == ascii_plus + || ch == ascii_minus + || ch == ascii_D + || ch == ascii_d + || ch == ascii_C + || ch == ascii_c ) { state = second_sign; p -= 1; @@ -2945,24 +2946,24 @@ numval_c( cblc_field_t *dest, errcode = p - pstart; p = pend; } - if( ch == mapped_plus ) + if( ch == ascii_plus ) { sign = 1; } - else if( ch == mapped_minus ) + else if( ch == ascii_minus ) { sign = -1; } - else if( (ch == mapped_D || ch == mapped_d) + else if( (ch == ascii_D || ch == ascii_d) && p < pend - && (*p == mapped_B || *p == mapped_b) ) + && (*p == ascii_B || *p == ascii_b) ) { sign = -1; p += 1; } - else if( (ch == mapped_C || ch == mapped_c) + else if( (ch == ascii_C || ch == ascii_c) && p < pend - && (*p == mapped_R || *p == mapped_r) ) + && (*p == ascii_R || *p == ascii_r) ) { sign = -1; p += 1; @@ -2972,7 +2973,7 @@ numval_c( cblc_field_t *dest, case final_space : // There should be only spaces until the end - if( ch == mapped_space ) + if( ch == ascii_space ) { continue; } @@ -3003,6 +3004,8 @@ numval_c( cblc_field_t *dest, truncation_e, NULL); } + free(currency_in_ascii); + free(pstart); return (int)errcode; } @@ -3910,12 +3913,12 @@ __gg__upper_case( cblc_field_t *dest, __gg__convert_encoding_length(PTRCAST(char, dest->data), length, from, - DEFAULT_CHARMAP_SOURCE); + DEFAULT_SOURCE_ENCODING); std::transform(dest->data, dest->data + dest_length, dest->data, [](unsigned char c) { return std::toupper(c); }); __gg__convert_encoding_length(PTRCAST(char, dest->data), length, - DEFAULT_CHARMAP_SOURCE, + DEFAULT_SOURCE_ENCODING, to); } @@ -3946,7 +3949,7 @@ __gg__when_compiled(cblc_field_t *dest, size_t tv_sec, long tv_nsec) char retval[DATE_STRING_BUFFER_SIZE]; timespec_to_string(retval, tp); __gg__convert_encoding(PTRCAST(char, retval), - DEFAULT_CHARMAP_SOURCE, + DEFAULT_SOURCE_ENCODING, dest->encoding); string_to_dest(dest, retval); } @@ -3992,8 +3995,8 @@ gets_int( int ndigits, // position (starting at 1) where the problem is. int retval = 0; - int checked_0 = charmap->mapped_character(ascii_0); - int checked_9 = charmap->mapped_character(ascii_9); + unsigned int checked_0 = charmap->mapped_character(ascii_0); + unsigned int checked_9 = charmap->mapped_character(ascii_9); memset(digits, 0xFF, ndigits * sizeof(int)); for(int i=1; i<=ndigits; i++) @@ -4004,7 +4007,7 @@ gets_int( int ndigits, retval = -i; break; } - int ch = *p++; + unsigned int ch = (unsigned char)*p++; if( ch < checked_0 || ch > checked_9 ) { // This isn't a digit zero through nine @@ -4502,19 +4505,19 @@ gets_nanoseconds( const char *f, // positive return value. A negative return value contains the number of // digits we processed, - int format_s = charmap_format->mapped_character(ascii_s); - int source_0 = charmap_source->mapped_character(ascii_0); - int source_9 = charmap_source->mapped_character(ascii_9); + unsigned int format_s = charmap_format->mapped_character(ascii_s); + unsigned int source_0 = charmap_source->mapped_character(ascii_0); + unsigned int source_9 = charmap_source->mapped_character(ascii_9); int errpos = 0; int ncount = 0; int nanoseconds = 0; const char *pinit = p; - while( f < f_end && *f == format_s && p < pend ) + while( f < f_end && (unsigned char)*f == format_s && p < pend ) { f += 1; - int ch = *p++; + unsigned int ch = (unsigned char)*p++; errpos += 1; if( ch < source_0 || ch > source_9 ) @@ -4560,6 +4563,10 @@ fill_cobol_tm(cobol_tm &ctm, charmap_t *charmap_format = __gg__get_charmap(par1->encoding); charmap_t *charmap_checked = __gg__get_charmap(par2->encoding); int checked_space = charmap_checked->mapped_character(ascii_space); + int source_plus = charmap_checked->mapped_character(ascii_plus); + int source_minus = charmap_checked->mapped_character(ascii_minus); + int source_zero = charmap_checked->mapped_character(ascii_zero); + int format_space = charmap_format->mapped_character(ascii_space); int format_T = charmap_format->mapped_character(ascii_T ); int format_colon = charmap_format->mapped_character(ascii_colon ); @@ -4576,6 +4583,8 @@ fill_cobol_tm(cobol_tm &ctm, int format_M = charmap_format->mapped_character(ascii_M ); int format_D = charmap_format->mapped_character(ascii_D ); int format_zero = charmap_format->mapped_character(ascii_zero ); + char decimal_point + = charmap_format->mapped_character(__gg__get_decimal_point()); // Let's eliminate trailing spaces... trim_trailing_spaces(format, format_end, format_space); @@ -4584,8 +4593,6 @@ fill_cobol_tm(cobol_tm &ctm, bool in_offset = false; bool in_nanoseconds = false; - char decimal_point = __gg__get_decimal_point(); - // We keep constant track of the current error location. int retval = 1; int errpos; @@ -4596,7 +4603,7 @@ fill_cobol_tm(cobol_tm &ctm, int bump; while( format < format_end && source < source_end ) { - char ch = *format; + unsigned char ch = *format; if( ch == format_T || ch == format_colon @@ -4605,7 +4612,7 @@ fill_cobol_tm(cobol_tm &ctm, { // These are just formatting characters. They need to be duplicated, // but are otherwise ignored. - if( *source != ch ) + if( (unsigned char)*source != ch ) { break; } @@ -4616,31 +4623,31 @@ fill_cobol_tm(cobol_tm &ctm, if( ch == format_plus ) { // This flags a following hhmm offset. It needs to match a '+' or '-' - if( *source != format_plus - && *source != format_minus - && *source != format_zero) + if( (unsigned char)*source != source_plus + && (unsigned char)*source != source_minus + && (unsigned char)*source != source_zero) { break; } - if( *source == format_zero ) + if( (unsigned char)*source == format_zero ) { // The next four characters have to be zeroes - if( source[1] != format_zero ) + if( (unsigned char)source[1] != format_zero ) { retval += 1; break; } - if( source[2] != format_zero ) + if( (unsigned char)source[2] != format_zero ) { retval += 2; break; } - if( source[3] != format_zero ) + if( (unsigned char)source[3] != format_zero ) { retval += 3; break; } - if( source[4] != format_zero ) + if( (unsigned char)source[4] != format_zero ) { retval += 4; break; @@ -4691,7 +4698,7 @@ fill_cobol_tm(cobol_tm &ctm, if( ch == format_D ) { // We have three possibilities: DDD, DD, and D - if( format[1] != format_D ) + if( (unsigned char)format[1] != format_D ) { // A singleton 'D' is a day-of-week errpos = gets_day_of_week(source, source_end, charmap_checked, ctm); @@ -4702,7 +4709,7 @@ fill_cobol_tm(cobol_tm &ctm, } bump = 1; } - else if( format[2] != format_D ) + else if( (unsigned char)format[2] != format_D ) { // This is DD, for day-of-month errpos = gets_day(source, source_end, charmap_checked, ctm); @@ -4798,7 +4805,8 @@ fill_cobol_tm(cobol_tm &ctm, if( ch == format_Z || ch == format_z ) { // This has to be the end of the road - if( std::toupper((unsigned char)source[0]) != 'Z' ) + if( (unsigned char)source[0] != format_Z + && (unsigned char)source[0] != format_z ) { retval += 0; break; @@ -5040,19 +5048,9 @@ __gg__lowest_algebraic( cblc_field_t *dest, static int floating_format_tester( char const * const f, - char const * const f_end, - cbl_encoding_t encoding) + char const * const f_end) { - charmap_t *charmap = __gg__get_charmap(encoding); - int mapped_space = charmap->mapped_character(ascii_space); - int mapped_plus = charmap->mapped_character(ascii_plus); - int mapped_minus = charmap->mapped_character(ascii_minus); - int mapped_0 = charmap->mapped_character(ascii_0); - int mapped_9 = charmap->mapped_character(ascii_9); - int mapped_E = charmap->mapped_character(ascii_E); - int mapped_e = charmap->mapped_character(ascii_e); - int decimal_point = charmap->mapped_character(__gg__get_decimal_point()); - + // This routine operates in ASCII space int retval = -1; enum @@ -5074,23 +5072,23 @@ floating_format_tester( char const * const f, switch(state) { case SPACE1: - if( ch == mapped_space ) + if( ch == ascii_space ) { // Just keep looking break; } - if( ch == mapped_minus - || ch == mapped_plus) + if( ch == ascii_minus + || ch == ascii_plus) { state = SPACE2; break; } - if( ch >= mapped_0 && ch <= mapped_9 ) + if( ch >= ascii_0 && ch <= ascii_9 ) { state = DIGITS1; break; } - if( decimal_point ) + if( __gg__decimal_point ) { state = DIGITS2; break; @@ -5100,16 +5098,16 @@ floating_format_tester( char const * const f, break; case SPACE2: - if( ch == mapped_space ) + if( ch == ascii_space ) { break; } - if( ch >= mapped_0 && ch <= mapped_9 ) + if( ch >= ascii_0 && ch <= ascii_9 ) { state = DIGITS1; break; } - if( ch == decimal_point ) + if( ch == __gg__decimal_point ) { state = DIGITS2; break; @@ -5118,16 +5116,16 @@ floating_format_tester( char const * const f, break; case DIGITS1: - if( ch >= mapped_0 && ch <= mapped_9 ) + if( ch >= ascii_0 && ch <= ascii_9 ) { break; } - if( ch == decimal_point ) + if( ch == __gg__decimal_point ) { state = DIGITS2; break; } - if( ch == mapped_space ) + if( ch == ascii_space ) { state = SPACE3; break; @@ -5136,16 +5134,16 @@ floating_format_tester( char const * const f, break; case DIGITS2: - if( ch >= mapped_0 && ch <= mapped_9 ) + if( ch >= ascii_0 && ch <= ascii_9 ) { break; } - if( ch == mapped_space ) + if( ch == ascii_space ) { state = SPACE3; break; } - if( ch == mapped_E || ch == mapped_e ) + if( ch == ascii_E || ch == ascii_e ) { state = SPACE4; break; @@ -5154,16 +5152,16 @@ floating_format_tester( char const * const f, break; case SPACE3: - if( ch == mapped_space ) + if( ch == ascii_space ) { break; } - if( ch >= mapped_0 && ch <= mapped_9 ) + if( ch >= ascii_0 && ch <= ascii_9 ) { retval = index; break; } - if( ch == mapped_E || ch == mapped_e ) + if( ch == ascii_E || ch == ascii_e ) { state = SPACE4; break; @@ -5172,16 +5170,16 @@ floating_format_tester( char const * const f, break; case SPACE4: - if( ch == mapped_space ) + if( ch == ascii_space ) { break; } - if( ch == mapped_minus || ch == mapped_plus ) + if( ch == ascii_minus || ch == ascii_plus ) { state = SPACE5; break; } - if( ch >= mapped_0 && ch <= mapped_9 ) + if( ch >= ascii_0 && ch <= ascii_9 ) { state = DIGITS3; break; @@ -5190,11 +5188,11 @@ floating_format_tester( char const * const f, break; case SPACE5: - if( ch == mapped_space ) + if( ch == ascii_space ) { break; } - if( ch >= mapped_0 && ch <= mapped_9 ) + if( ch >= ascii_0 && ch <= ascii_9 ) { state = DIGITS3; break; @@ -5203,11 +5201,11 @@ floating_format_tester( char const * const f, break; case DIGITS3: - if( ch >= mapped_0 && ch <= mapped_9 ) + if( ch >= ascii_0 && ch <= ascii_9 ) { break; } - if( ch == mapped_space ) + if( ch == ascii_space ) { state = SPACE6; break; @@ -5216,7 +5214,7 @@ floating_format_tester( char const * const f, break; case SPACE6: - if( ch == mapped_space ) + if( ch == ascii_space ) { break; } @@ -5242,16 +5240,19 @@ __gg__numval_f( cblc_field_t *dest, size_t source_offset, size_t source_size) { + // It's just easiest for this routine to operate in ASCII space: + size_t nbytes; + char *converted = __gg__iconverter(source->encoding, + DEFAULT_SOURCE_ENCODING, + PTRCAST(char, source->data + source_offset), + source_size, + &nbytes); GCOB_FP128 value = 0; - const char *data = PTRCAST(char, (source->data + source_offset)); + const char *data = converted; const char *data_end = data + source_size; - charmap_t *charmap = __gg__get_charmap(source->encoding); - int mapped_space = charmap->mapped_character(ascii_space); int error = floating_format_tester( data, - data_end, - source->encoding); - + data_end); if( error || source_size >= 256 ) { exception_raise(ec_argument_function_e); @@ -5264,12 +5265,13 @@ __gg__numval_f( cblc_field_t *dest, while( data < data_end ) { char ch = *data++; - if( ch != mapped_space ) + if( ch != ascii_space ) { *p++ = ch; } } *p++ = '\0'; + // This next call is why we needed to be in ASCII space. value = strtofp128(ach, NULL); } __gg__float128_to_field(dest, @@ -5285,13 +5287,18 @@ __gg__test_numval_f(cblc_field_t *dest, size_t source_offset, size_t source_size) { - const char *data = PTRCAST(char, (source->data + source_offset)); + // It's just easiest for this routine to operate in ASCII space: + size_t nbytes; + char *converted = __gg__iconverter(source->encoding, + DEFAULT_SOURCE_ENCODING, + PTRCAST(char, source->data + source_offset), + source_size, + &nbytes); + + const char *data = converted; const char *data_end = data + source_size; - int error = floating_format_tester( data, - data_end, - source->encoding); - + data_end); __gg__int128_to_field(dest, error, NO_RDIGITS, @@ -5314,14 +5321,52 @@ ismatch(const char *a1, const char *a2, const char *b1, const char *b2) } static bool -iscasematch(const char *a1, const char *a2, const char *b1, const char *b2) +iscasematch(const char *a1, const char *a2, + const char *b1, const char *b2, + bool is_ebcdic) { + static const unsigned int ebcdic_lower[256] = + { + 0x00, 0x01, 0x02, 0x03, 0x04, 0x05, 0x06, 0x07, 0x08, 0x09, 0x0a, 0x0b, 0x0c, 0x0d, 0x0e, 0x0f, + 0x10, 0x11, 0x12, 0x13, 0x14, 0x15, 0x16, 0x17, 0x18, 0x19, 0x1a, 0x1b, 0x1c, 0x1d, 0x1e, 0x1f, + 0x20, 0x21, 0x22, 0x23, 0x24, 0x25, 0x26, 0x27, 0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x2d, 0x2e, 0x2f, + 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x36, 0x37, 0x38, 0x39, 0x3a, 0x3b, 0x3c, 0x3d, 0x3e, 0x3f, + 0x40, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47, 0x48, 0x49, 0x4a, 0x4b, 0x4c, 0x4d, 0x4e, 0x4f, + 0x50, 0x51, 0x52, 0x53, 0x54, 0x55, 0x56, 0x57, 0x58, 0x59, 0x5a, 0x5b, 0x5c, 0x5d, 0x5e, 0x5f, + 0x60, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67, 0x68, 0x69, 0x6a, 0x6b, 0x6c, 0x6d, 0x6e, 0x6f, + 0x70, 0x71, 0x72, 0x73, 0x74, 0x75, 0x76, 0x77, 0x78, 0x79, 0x7a, 0x7b, 0x7c, 0x7d, 0x7e, 0x7f, + 0x80, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 0x8a, 0x8b, 0x8c, 0x8d, 0x8e, 0x8f, + 0x90, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97, 0x98, 0x99, 0x9a, 0x9b, 0x9c, 0x9d, 0x9e, 0x9f, + 0xa0, 0xa1, 0xa2, 0xa3, 0xa4, 0xa5, 0xa6, 0xa7, 0xa8, 0xa9, 0xaa, 0xab, 0xac, 0xad, 0xae, 0xaf, + 0xb0, 0xb1, 0xb2, 0xb3, 0xb4, 0xb5, 0xb6, 0xb7, 0xb8, 0xb9, 0xba, 0xbb, 0xbc, 0xbd, 0xbe, 0xbf, + 0xc0, 0x81, 0x82, 0x83, 0x84, 0x85, 0x86, 0x87, 0x88, 0x89, 0xca, 0xcb, 0xcc, 0xcd, 0xce, 0xcf, + 0xd0, 0x91, 0x92, 0x93, 0x94, 0x95, 0x96, 0x97, 0x98, 0x99, 0xda, 0xdb, 0xdc, 0xdd, 0xde, 0xdf, + 0xe0, 0xe1, 0xa2, 0xa3, 0xa4, 0xa5, 0xa6, 0xa7, 0xa8, 0xa9, 0xea, 0xeb, 0xec, 0xed, 0xee, 0xef, + 0xf0, 0xf1, 0xf2, 0xf3, 0xf4, 0xf5, 0xf6, 0xf7, 0xf8, 0xf9, 0xfa, 0xfb, 0xfc, 0xfd, 0xfe, 0xff, + }; + bool retval = true; - while( a1 < a2 && b1 < b2 ) + + if( !is_ebcdic ) { - if( std::tolower((unsigned char)*a1++) != std::tolower((unsigned char)*b1++) ) + while( a1 < a2 && b1 < b2 ) { - retval = false; + if( std::tolower((unsigned char)*a1++) + != std::tolower((unsigned char)*b1++) ) + { + retval = false; + } + } + } + else + { + while( a1 < a2 && b1 < b2 ) + { + if( ebcdic_lower[(unsigned int)(unsigned char)*a1++] + != ebcdic_lower[(unsigned int)(unsigned char)*b1++] ) + { + retval = false; + } } } return retval; @@ -5353,13 +5398,14 @@ const char * strcasestr( const char *haystack, const char *haystack_e, const char *needle, - const char *needle_e) + const char *needle_e, + bool is_ebcdic) { const char *retval = NULL; const char *pend = haystack_e - (needle_e - needle); while( haystack <= pend ) { - if(iscasematch(haystack, haystack_e, needle, needle_e)) + if(iscasematch(haystack, haystack_e, needle, needle_e, is_ebcdic)) { retval = haystack; break; @@ -5394,13 +5440,14 @@ const char * strcaselaststr( const char *haystack, const char *haystack_e, const char *needle, - const char *needle_e) + const char *needle_e, + bool is_ebcdic) { const char *retval = NULL; const char *pend = haystack_e - (needle_e - needle); while( haystack <= pend ) { - if(iscasematch(haystack, haystack_e, needle, needle_e)) + if(iscasematch(haystack, haystack_e, needle, needle_e, is_ebcdic)) { retval = haystack; } @@ -5409,7 +5456,6 @@ strcaselaststr( const char *haystack, return retval; } - extern "C" void __gg__substitute( cblc_field_t *dest, @@ -5442,6 +5488,9 @@ __gg__substitute( cblc_field_t *dest, const char **pflasts = static_cast<const char **>(malloc(N * sizeof(char *))); massert(pflasts); + const charmap_t *charmap = __gg__get_charmap(arg1_f->encoding); + bool is_ebcdic = charmap->is_like_ebcdic(); + if( arg1_s == 0 ) { exception_raise(ec_argument_function_e); @@ -5462,14 +5511,16 @@ __gg__substitute( cblc_field_t *dest, pflasts[i] = strcasestr(haystack, haystack_e, PTRCAST(char, (arg2_f[i]->data+arg2_o[i])), - PTRCAST(char, (arg2_f[i]->data+arg2_o[i])) + arg2_s[i]); + PTRCAST(char, (arg2_f[i]->data+arg2_o[i])) + arg2_s[i], + is_ebcdic); } else if( control[i] & substitute_last_e) { pflasts[i] = strcaselaststr(haystack, haystack_e, PTRCAST(char, (arg2_f[i]->data+arg2_o[i])), - PTRCAST(char, (arg2_f[i]->data+arg2_o[i])) + arg2_s[i]); + PTRCAST(char, (arg2_f[i]->data+arg2_o[i])) + arg2_s[i], + is_ebcdic); } else { @@ -5532,7 +5583,8 @@ __gg__substitute( cblc_field_t *dest, haystack, haystack_e, needle, - needle_e); + needle_e, + is_ebcdic); if( !matched ) { matched = !(control[i] & substitute_anycase_e) && ismatch(haystack, @@ -5622,11 +5674,11 @@ __gg__locale_compare( cblc_field_t *dest, } } - __gg__adjust_dest_size(dest, 1); - dest->data[0] = *achretval; - __gg__convert_encoding(PTRCAST(char, dest->data), - DEFAULT_CHARMAP_SOURCE, + __gg__convert_encoding(achretval, + DEFAULT_SOURCE_ENCODING, dest->encoding); + memcpy(dest->data, achretval, strlen(achretval)); + __gg__adjust_dest_size(dest, strlen(achretval)); } extern "C" @@ -5659,12 +5711,11 @@ __gg__locale_date(cblc_field_t *dest, strcpy(ach, nl_langinfo(D_FMT)); strftime(ach, sizeof(ach), nl_langinfo(D_FMT), &tm); } - - __gg__adjust_dest_size(dest, strlen(ach)); - __gg__convert_encoding(PTRCAST(char, dest->data), - DEFAULT_CHARMAP_SOURCE, + __gg__convert_encoding(ach, + DEFAULT_SOURCE_ENCODING, dest->encoding); memcpy(dest->data, ach, strlen(ach)); + __gg__adjust_dest_size(dest, strlen(ach)); } extern "C" @@ -5698,11 +5749,11 @@ __gg__locale_time(cblc_field_t *dest, strftime(ach, sizeof(ach), nl_langinfo(T_FMT), &tm); } - __gg__adjust_dest_size(dest, strlen(ach)); - __gg__convert_encoding(PTRCAST(char, dest->data), - DEFAULT_CHARMAP_SOURCE, + __gg__convert_encoding(ach, + DEFAULT_SOURCE_ENCODING, dest->encoding); memcpy(dest->data, ach, strlen(ach)); + __gg__adjust_dest_size(dest, strlen(ach)); } extern "C" @@ -5738,9 +5789,9 @@ __gg__locale_time_from_seconds( cblc_field_t *dest, strftime(ach, sizeof(ach), nl_langinfo(T_FMT), &tm); } - __gg__adjust_dest_size(dest, strlen(ach)); - __gg__convert_encoding(PTRCAST(char, dest->data), - DEFAULT_CHARMAP_SOURCE, + __gg__convert_encoding(ach, + DEFAULT_SOURCE_ENCODING, dest->encoding); memcpy(dest->data, ach, strlen(ach)); + __gg__adjust_dest_size(dest, strlen(ach)); } diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc index 89153bb..f587fbf 100644 --- a/libgcobol/libgcobol.cc +++ b/libgcobol/libgcobol.cc @@ -289,6 +289,7 @@ class ec_status_t { case file_op_write: return "write"; case file_op_rewrite: return "rewrite"; case file_op_delete: return "delete"; + case file_op_remove: return "remove"; } return "???"; } @@ -1627,7 +1628,7 @@ int128_to_field(cblc_field_t *var, var->picture); size_t outlength; const char *converted = __gg__iconverter( - DEFAULT_CHARMAP_SOURCE, + DEFAULT_SOURCE_ENCODING, var->encoding, PTRCAST(char, location), var->capacity, @@ -2755,7 +2756,7 @@ __gg__dirty_to_float( const char *dirty, int delta_r = 0; // We now loop over the remaining input characters: - char ch = '\0'; + unsigned char ch = '\0'; charmap_t *charmap = __gg__get_charmap(field->encoding); @@ -3055,7 +3056,7 @@ format_for_display_internal(char **dest, // This buffer is larger than can validly be needed unsigned char converted[128]; size_t outlength; - retval = DEFAULT_CHARMAP_SOURCE; + retval = DEFAULT_SOURCE_ENCODING; const char *mapped = __gg__iconverter( var->encoding, retval, @@ -3285,7 +3286,7 @@ format_for_display_internal(char **dest, } char ach[128]; - retval = DEFAULT_CHARMAP_SOURCE; + retval = DEFAULT_SOURCE_ENCODING; charmap_t *charmap = __gg__get_charmap(retval); __gg__binary_to_string_ascii(ach, digits, value); @@ -3724,7 +3725,13 @@ get_float128( const cblc_field_t *field, { if( __gg__decimal_point == '.' ) { - retval = strtofp128(field->initial, NULL); + size_t charsout; + char *converted = __gg__iconverter(field->encoding, + DEFAULT_SOURCE_ENCODING, + field->initial, + strlen(field->initial), + &charsout); + retval = strtofp128(converted, NULL); } else { @@ -3954,7 +3961,7 @@ compare_field_class(const cblc_field_t *conditional, walker = right + right_len; GCOB_FP128 left_value; - if( left_flag == 'F' && left[0] == 'Z' ) + if( left_flag == ascii_F && left[0] == ascii_Z ) { left_value = 0; } @@ -4375,9 +4382,11 @@ __gg__compare_2(cblc_field_t *left_side, } massert(buffer); strcpy(buffer, right_side->initial); + if( __gg__decimal_point == ',' ) { - // We need to replace any commas with periods + // We are operating in DECIMAL IS COMMA mode, so we need to + // replace any commas with periods. char *p = strchr(buffer, ','); if(p) { @@ -4385,8 +4394,9 @@ __gg__compare_2(cblc_field_t *left_side, } } - // buffer[] now contains the string we want to convert - + // buffer[] now contains the right-side string we want to convert + // to one of the floating-point types. We want them to be the + // same size: switch(left_side->capacity) { case 4: @@ -4970,7 +4980,7 @@ init_var_both(cblc_field_t *var, { strcpy(first, walker); __gg__convert_encoding( first, - DEFAULT_CHARMAP_SOURCE, + DEFAULT_SOURCE_ENCODING, var->encoding); } walker += strlen(first) + 1; @@ -4987,7 +4997,7 @@ init_var_both(cblc_field_t *var, else { __gg__convert_encoding( last, - DEFAULT_CHARMAP_SOURCE, + DEFAULT_SOURCE_ENCODING, var->encoding); } walker += strlen(last) + 1; @@ -6234,7 +6244,7 @@ __gg__move( cblc_field_t *fdest, // ascii: size_t charsout; const char *converted = __gg__iconverter(fsource->encoding, - DEFAULT_CHARMAP_SOURCE, + DEFAULT_SOURCE_ENCODING, PTRCAST(char, fsource->data+source_offset), source_size, &charsout); @@ -9142,11 +9152,17 @@ display_both(cblc_field_t *field, } } + size_t conversion_length = strlen(display_string); + if( charmap->stride() != 1 ) + { + conversion_length = qual_size; + } + size_t outlength; const char *converted = __gg__iconverter( encoding, encout, display_string, - strlen(display_string), + conversion_length, &outlength); write(file_descriptor, converted, @@ -10059,7 +10075,7 @@ is_numeric_display_numeric(cblc_field_t *field, size_t offset, size_t size) digits_e -= 1; unsigned char final_char = (unsigned char)*digits_e; final_char = charmap->set_digit_negative(final_char, false); - if( final_char<charmap->mapped_character(ascii_0) + if( final_char<charmap->mapped_character(ascii_0) || final_char>charmap->mapped_character(ascii_9) ) { retval = 0; @@ -10420,14 +10436,14 @@ accept_envar( cblc_field_t *tgt, // Convert the name to the console codeset: __gg__convert_encoding( trimmed_env, encoding, - DEFAULT_CHARMAP_SOURCE); + DEFAULT_SOURCE_ENCODING); // Pick up the environment variable, and convert it to the internal codeset const char *p = getenv(trimmed_env); if(p) { retval = 0; // Okay - move_string(tgt, tgt_offset, tgt_length, p, DEFAULT_CHARMAP_SOURCE); + move_string(tgt, tgt_offset, tgt_length, p, DEFAULT_SOURCE_ENCODING); } free(env); } @@ -10638,7 +10654,7 @@ __gg__get_argv( cblc_field_t *dest, dest_offset, dest_length, stashed_argv[N], - DEFAULT_CHARMAP_SOURCE); + DEFAULT_SOURCE_ENCODING); retcode = 0; // Okay } return retcode; @@ -11381,7 +11397,7 @@ __gg__unstring( const cblc_field_t *id1, // The string being unstring id5_o[nreceiver], id5_s[nreceiver], "", - DEFAULT_CHARMAP_SOURCE); + DEFAULT_SOURCE_ENCODING); } } @@ -11768,6 +11784,7 @@ __gg__check_fatal_exception() case file_op_write: case file_op_rewrite: case file_op_delete: + case file_op_remove: break; } } else { @@ -12041,6 +12058,23 @@ __gg__adjust_dest_size(cblc_field_t *dest, size_t ncount) extern "C" void +__gg__adjust_encoding(cblc_field_t *field) + { + // Assume that field->data is in ASCII; We need to convert it to the target + size_t nbytes; + const char *converted = __gg__iconverter(DEFAULT_SOURCE_ENCODING, + field->encoding, + PTRCAST(char, field->data), + field->capacity, + &nbytes); + size_t tocopy = std::min(nbytes, field->allocated); + field->capacity = tocopy; + memcpy(field->data, converted, tocopy); + } + + +extern "C" +void __gg__func_exception_location(cblc_field_t *dest) { char ach[512] = " "; @@ -12088,6 +12122,7 @@ __gg__func_exception_location(cblc_field_t *dest) } __gg__adjust_dest_size(dest, strlen(ach)); memcpy(dest->data, ach, strlen(ach)); + __gg__adjust_encoding(dest); } extern "C" @@ -12102,6 +12137,7 @@ __gg__func_exception_statement(cblc_field_t *dest) } __gg__adjust_dest_size(dest, strlen(ach)); memcpy(dest->data, ach, strlen(ach)); + __gg__adjust_encoding(dest); } extern "C" @@ -12128,6 +12164,7 @@ __gg__func_exception_status(cblc_field_t *dest) } __gg__adjust_dest_size(dest, strlen(ach)); memcpy(dest->data, ach, strlen(ach)); + __gg__adjust_encoding(dest); } extern "C" @@ -12195,6 +12232,7 @@ __gg__func_exception_file(cblc_field_t *dest, __gg__adjust_dest_size(dest, strlen(ach)); memcpy(dest->data, ach, strlen(ach)); + __gg__adjust_encoding(dest); } extern "C" @@ -12693,7 +12731,7 @@ __gg__just_mangle_name( const cblc_field_t *field, // We need ach_name to be in ASCII: size_t charsout; const char *converted = __gg__iconverter(field->encoding, - DEFAULT_CHARMAP_SOURCE, + DEFAULT_SOURCE_ENCODING, PTRCAST(char, field->data), length, &charsout); @@ -12784,7 +12822,7 @@ __gg__function_handle_from_name(int program_id, size_t charsout; const char *converted = __gg__iconverter(field->encoding, - DEFAULT_CHARMAP_SOURCE, + DEFAULT_SOURCE_ENCODING, PTRCAST(char, field->data + offset), length, &charsout); @@ -13093,6 +13131,7 @@ __gg__deallocate( cblc_field_t *target, static int get_the_byte(cblc_field_t *field) { + // This is a helper routine for ALLOCATE int retval = -1; if( field ) { @@ -13100,7 +13139,14 @@ get_the_byte(cblc_field_t *field) retval = __gg__fc_char(field); if(retval == -1) { - retval = (int)__gg__get_integer_binary_value(field); + retval = (int)(unsigned char)__gg__get_integer_binary_value(field); + } + else + { + // This is a bit of a hack. It turns out the figurative constant is + // encoded in ASCII. We need it to be in the current DISPLAY encoding. + charmap_t *charmap = __gg__get_charmap(__gg__display_encoding); + retval = charmap->mapped_character(retval); } } return retval; @@ -13373,6 +13419,7 @@ __gg__module_name(cblc_field_t *dest, module_type_t type) __gg__adjust_dest_size(dest, strlen(result)); memcpy(dest->data, result, strlen(result)+1); + __gg__adjust_encoding(dest); } /* @@ -13652,7 +13699,7 @@ __gg__accept_arg_value( cblc_field_t *dest, dest_offset, dest_length, stashed_argv[sv_argument_number], - DEFAULT_CHARMAP_SOURCE); + DEFAULT_SOURCE_ENCODING); retcode = 0; // Okay // The Fujitsu spec says bump this value by one. diff --git a/libgcobol/xmlparse.cc b/libgcobol/xmlparse.cc index 54b9f02..d89d480 100644 --- a/libgcobol/xmlparse.cc +++ b/libgcobol/xmlparse.cc @@ -408,6 +408,7 @@ static void fatalError(void * CTX, const char * msg, ...) } #if 0 + static xmlEntityPtr getEntity(void * CTX, const xmlChar * name) { SAYSO_DATAZ(name); } @@ -484,6 +485,7 @@ static void setDocumentLocator(void * CTX, * xmlCtxtGetStandalone() to get data from the XML declaration. */ static void startDocument(void * CTX) + { SAYSO(); } @@ -616,7 +618,6 @@ xmlchar_of( const char input[] ) { static const char * xmlParserErrors_str( xmlParserErrors erc, const char name[] ) { const char *msg = "???"; - switch( erc ) { case XML_ERR_OK: msg = "Success"; @@ -630,6 +631,7 @@ xmlParserErrors_str( xmlParserErrors erc, const char name[] ) { case XML_ERR_UNSUPPORTED_ENCODING: msg = "Unsupported character encoding"; break; + #if LIBXML_VERSION >= 21400 case XML_ERR_RESOURCE_LIMIT: msg = "Internal resource limit like maximum amplification factor exceeded"; @@ -710,6 +712,7 @@ static class context_t { } } + protected: void init() { const char *external_entities = nullptr; diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index 4f3b303..46e7df5 100644 --- a/libgfortran/Makefile.am +++ b/libgfortran/Makefile.am @@ -218,6 +218,7 @@ endif gfor_src= \ runtime/bounds.c \ runtime/compile_options.c \ +runtime/deep_copy.c \ runtime/memory.c \ runtime/string.c \ runtime/select.c diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in index ce828b2..116e80f 100644 --- a/libgfortran/Makefile.in +++ b/libgfortran/Makefile.in @@ -231,7 +231,7 @@ libgfortran_la_LIBADD = @LIBGFOR_MINIMAL_FALSE@ runtime/fpu.lo runtime/main.lo \ @LIBGFOR_MINIMAL_FALSE@ runtime/pause.lo runtime/stop.lo am__objects_3 = runtime/bounds.lo runtime/compile_options.lo \ - runtime/memory.lo runtime/string.lo runtime/select.lo \ + runtime/deep_copy.lo runtime/memory.lo runtime/string.lo runtime/select.lo \ $(am__objects_1) $(am__objects_2) am__objects_4 = generated/matmul_i1.lo generated/matmul_i2.lo \ generated/matmul_i4.lo generated/matmul_i8.lo \ @@ -1013,8 +1013,8 @@ gfor_helper_src = intrinsics/associated.c intrinsics/abort.c \ @IEEE_SUPPORT_TRUE@ieee/ieee_exceptions.F90 \ @IEEE_SUPPORT_TRUE@ieee/ieee_features.F90 -gfor_src = runtime/bounds.c runtime/compile_options.c runtime/memory.c \ - runtime/string.c runtime/select.c $(am__append_6) \ +gfor_src = runtime/bounds.c runtime/compile_options.c runtime/deep_copy.c \ + runtime/memory.c runtime/string.c runtime/select.c $(am__append_6) \ $(am__append_7) i_matmul_c = \ generated/matmul_i1.c \ @@ -1981,6 +1981,8 @@ runtime/bounds.lo: runtime/$(am__dirstamp) \ runtime/$(DEPDIR)/$(am__dirstamp) runtime/compile_options.lo: runtime/$(am__dirstamp) \ runtime/$(DEPDIR)/$(am__dirstamp) +runtime/deep_copy.lo: runtime/$(am__dirstamp) \ + runtime/$(DEPDIR)/$(am__dirstamp) runtime/memory.lo: runtime/$(am__dirstamp) \ runtime/$(DEPDIR)/$(am__dirstamp) runtime/string.lo: runtime/$(am__dirstamp) \ diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map index 98808dc..fc01665 100644 --- a/libgfortran/gfortran.map +++ b/libgfortran/gfortran.map @@ -2037,4 +2037,5 @@ GFORTRAN_16 { global: _gfortran_string_split; _gfortran_string_split_char4; + _gfortran_cfi_deep_copy_array; } GFORTRAN_15.2; diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index 25c3cb6..71ec640 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -914,6 +914,14 @@ internal_proto(xcalloc); extern void *xrealloc (void *, size_t); internal_proto(xrealloc); +/* deep_copy.c - Runtime helper for recursive allocatable array components */ + +struct CFI_cdesc_t; +extern void cfi_deep_copy_array (gfc_array_void *, + gfc_array_void *, + void (*copy_element) (void *, void *)); +export_proto(cfi_deep_copy_array); + /* environ.c */ extern void init_variables (void); diff --git a/libgfortran/runtime/deep_copy.c b/libgfortran/runtime/deep_copy.c new file mode 100644 index 0000000..6567400 --- /dev/null +++ b/libgfortran/runtime/deep_copy.c @@ -0,0 +1,125 @@ +/* Deep copy support for allocatable components in derived types. + Copyright (C) 2025 Free Software Foundation, Inc. + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 3 of the License, or (at your option) any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. */ + +#include "libgfortran.h" +#include <string.h> + +/* Runtime helper for deep copying allocatable array components when the + element type contains nested allocatable components. The front end handles + allocation and deallocation; this helper performs element-wise copies using + the compiler-generated element copier so that recursion takes place at + runtime. */ + +static inline size_t +descriptor_elem_size (gfc_array_void *desc) +{ + size_t size = GFC_DESCRIPTOR_SIZE (desc); + return size == 0 ? 1 : size; +} + +void +cfi_deep_copy_array (gfc_array_void *dest, gfc_array_void *src, + void (*copy_element) (void *, void *)) +{ + int rank; + size_t src_elem_size; + size_t dest_elem_size; + index_type extent[GFC_MAX_DIMENSIONS]; + index_type src_stride_bytes[GFC_MAX_DIMENSIONS]; + index_type dest_stride_bytes[GFC_MAX_DIMENSIONS]; + index_type count[GFC_MAX_DIMENSIONS]; + char *src_ptr; + char *dest_ptr; + + if (src == NULL || dest == NULL) + return; + + if (GFC_DESCRIPTOR_DATA (src) == NULL) + { + if (GFC_DESCRIPTOR_DATA (dest) != NULL) + internal_error (NULL, "cfi_deep_copy_array: destination must be " + "deallocated when source is not allocated"); + return; + } + + if (GFC_DESCRIPTOR_DATA (dest) == NULL) + internal_error (NULL, "cfi_deep_copy_array: destination not allocated"); + + rank = GFC_DESCRIPTOR_RANK (src); + src_elem_size = descriptor_elem_size (src); + dest_elem_size = descriptor_elem_size (dest); + + if (rank <= 0) + { + memcpy (GFC_DESCRIPTOR_DATA (dest), GFC_DESCRIPTOR_DATA (src), + src_elem_size); + if (copy_element != NULL) + copy_element (GFC_DESCRIPTOR_DATA (dest), + GFC_DESCRIPTOR_DATA (src)); + return; + } + + for (int dim = 0; dim < rank; dim++) + { + extent[dim] = GFC_DESCRIPTOR_EXTENT (src, dim); + if (extent[dim] <= 0) + return; + + src_stride_bytes[dim] + = GFC_DESCRIPTOR_STRIDE (src, dim) * src_elem_size; + dest_stride_bytes[dim] + = GFC_DESCRIPTOR_STRIDE (dest, dim) * dest_elem_size; + count[dim] = 0; + } + + src_ptr = (char *) GFC_DESCRIPTOR_DATA (src); + dest_ptr = (char *) GFC_DESCRIPTOR_DATA (dest); + + while (true) + { + memcpy (dest_ptr, src_ptr, src_elem_size); + if (copy_element != NULL) + copy_element (dest_ptr, src_ptr); + + dest_ptr += dest_stride_bytes[0]; + src_ptr += src_stride_bytes[0]; + count[0]++; + + int dim = 0; + while (count[dim] == extent[dim]) + { + count[dim] = 0; + dest_ptr -= dest_stride_bytes[dim] * extent[dim]; + src_ptr -= src_stride_bytes[dim] * extent[dim]; + dim++; + if (dim == rank) + return; + count[dim]++; + dest_ptr += dest_stride_bytes[dim]; + src_ptr += src_stride_bytes[dim]; + } + } +} + +export_proto(cfi_deep_copy_array); diff --git a/libgomp/ChangeLog b/libgomp/ChangeLog index e2e14eb..468539a 100644 --- a/libgomp/ChangeLog +++ b/libgomp/ChangeLog @@ -1,3 +1,8 @@ +2025-11-05 Tobias Burnus <tburnus@baylibre.com> + + * testsuite/libgomp.c++/target-std__multimap-concurrent.C: Fix memory + freeing of device allocated memory with USM. + 2025-11-03 Sam James <sam@gentoo.org> * configure: Regenerate. diff --git a/libgomp/testsuite/libgomp.c++/target-std__multimap-concurrent.C b/libgomp/testsuite/libgomp.c++/target-std__multimap-concurrent.C index 6a4a4e8..8dbc912 100644 --- a/libgomp/testsuite/libgomp.c++/target-std__multimap-concurrent.C +++ b/libgomp/testsuite/libgomp.c++/target-std__multimap-concurrent.C @@ -4,6 +4,7 @@ #include <stdlib.h> #include <time.h> #include <map> +#include <omp.h> // Make sure that KEY_MAX is less than N to ensure some duplicate keys. #define N 3000 @@ -53,6 +54,16 @@ int main (void) for (auto it = range.first; it != range.second; ++it) sum += (long long) it->first * it->second; } +#ifdef MEM_SHARED + /* Even with USM, memory allocated on the device (with _map.insert) + must be freed on the device. */ + if (omp_get_default_device () != omp_initial_device + && omp_get_default_device () != omp_get_num_devices ()) + { + #pragma omp target + _map.clear (); + } +#endif #ifndef MEM_SHARED #pragma omp target diff --git a/libiberty/simple-object-coff.c b/libiberty/simple-object-coff.c index 922477f..7f3b462 100644 --- a/libiberty/simple-object-coff.c +++ b/libiberty/simple-object-coff.c @@ -57,6 +57,32 @@ struct external_filehdr unsigned char f_flags[2]; /* flags */ }; +/* BigObj COFF file header. */ + +struct external_filehdr_bigobj +{ + unsigned char sig1[2]; /* Must be 0x0000 */ + unsigned char sig2[2]; /* Must be 0xFFFF */ + unsigned char version[2]; /* Version, currently 2 */ + unsigned char machine[2]; /* Machine type */ + unsigned char timdat[4]; /* time & date stamp */ + unsigned char classid[16]; /* Magic GUID that identifies BigObj format */ + unsigned char sizeofdata[4]; /* Size of data (unused, set to 0) */ + unsigned char flags[4]; /* Flags (unused, set to 0) */ + unsigned char metadatasize[4]; /* Metadata size (unused, set to 0) */ + unsigned char metadataoffset[4]; /* Metadata offset (unused, set to 0) */ + unsigned char nscns[4]; /* number of sections (32-bit!) */ + unsigned char symptr[4]; /* file pointer to symtab */ + unsigned char nsyms[4]; /* number of symtab entries */ +}; + +/* The BigObj magic GUID (ClassID). */ +static const unsigned char bigobj_magic[16] = +{ + 0xC7, 0xA1, 0xBA, 0xD1, 0xEE, 0xBA, 0xA9, 0x4B, + 0xAF, 0x20, 0xFA, 0xF6, 0x6A, 0xA4, 0xDC, 0xB8 +}; + /* Bits for filehdr f_flags field. */ #define F_EXEC (0x0002) @@ -119,6 +145,28 @@ struct external_syment unsigned char e_numaux[1]; }; +/* BigObj COFF symbol table entry (20 bytes instead of 18). */ + +struct external_syment_bigobj +{ + union + { + unsigned char e_name[E_SYMNMLEN]; + + struct + { + unsigned char e_zeroes[4]; + unsigned char e_offset[4]; + } e; + } e; + + unsigned char e_value[4]; + unsigned char e_scnum[4]; /* 32-bit section number! */ + unsigned char e_type[2]; + unsigned char e_sclass[1]; + unsigned char e_numaux[1]; +}; + /* Length allowed for filename in aux sym format 4. */ #define E_FILNMLEN 18 @@ -149,6 +197,33 @@ union external_auxent } x_scn; }; +/* BigObj auxiliary symbol (20 bytes to match symbol size). */ + +union external_auxent_bigobj +{ + /* Aux sym format 4: file. */ + union + { + char x_fname[E_FILNMLEN]; + struct + { + unsigned char x_zeroes[4]; + unsigned char x_offset[4]; + } x_n; + } x_file; + /* Aux sym format 5: section. */ + struct + { + unsigned char x_scnlen[4]; /* section length */ + unsigned char x_nreloc[2]; /* # relocation entries */ + unsigned char x_nlinno[2]; /* # line numbers */ + unsigned char x_checksum[4]; /* section COMDAT checksum */ + unsigned char x_associated[2]; /* COMDAT assoc section index */ + unsigned char x_comdat[1]; /* COMDAT selection number */ + unsigned char x_pad[3]; /* Padding to 20 bytes */ + } x_scn; +}; + /* Symbol-related constants. */ #define IMAGE_SYM_DEBUG (-2) @@ -168,8 +243,10 @@ struct simple_object_coff_read unsigned short magic; /* Whether the file is big-endian. */ unsigned char is_big_endian; + /* Whether this is BigObj format. */ + unsigned char is_bigobj; /* Number of sections. */ - unsigned short nscns; + unsigned int nscns; /* File offset of symbol table. */ off_t symptr; /* Number of symbol table entries. */ @@ -188,6 +265,8 @@ struct simple_object_coff_attributes unsigned short magic; /* Whether the file is big-endian. */ unsigned char is_big_endian; + /* Whether this is BigObj format. */ + unsigned char is_bigobj; /* Flags. */ unsigned short flags; }; @@ -240,10 +319,12 @@ simple_object_coff_match (unsigned char header[SIMPLE_OBJECT_MATCH_HEADER_LEN], int is_big_endian; unsigned short (*fetch_16) (const unsigned char *); unsigned int (*fetch_32) (const unsigned char *); - unsigned char hdrbuf[sizeof (struct external_filehdr)]; + unsigned char hdrbuf[sizeof (struct external_filehdr_bigobj)]; unsigned short flags; struct simple_object_coff_read *ocr; + unsigned short sig1, sig2; + /* Try regular COFF first. */ c = sizeof (coff_magic) / sizeof (coff_magic[0]); magic_big = simple_object_fetch_big_16 (header); magic_little = simple_object_fetch_little_16 (header); @@ -254,12 +335,64 @@ simple_object_coff_match (unsigned char header[SIMPLE_OBJECT_MATCH_HEADER_LEN], : coff_magic[i].magic == magic_little) break; } - if (i >= c) + + /* Check for BigObj if regular COFF didn't match. */ + sig1 = simple_object_fetch_little_16 (header); + sig2 = simple_object_fetch_little_16 (header + 2); + + if (i >= c && (sig1 != 0 || sig2 != 0xFFFF)) { + /* Not regular COFF and not BigObj. */ *errmsg = NULL; *err = 0; return NULL; } + + if (sig1 == 0 && sig2 == 0xFFFF) + { + /* This looks like BigObj. Verify the ClassID. */ + unsigned char bigobj_hdrbuf[sizeof (struct external_filehdr_bigobj)]; + + if (!simple_object_internal_read (descriptor, offset, bigobj_hdrbuf, + sizeof bigobj_hdrbuf, errmsg, err)) + return NULL; + + if (memcmp (bigobj_hdrbuf + offsetof (struct external_filehdr_bigobj, + classid), + bigobj_magic, 16) != 0) + { + *errmsg = NULL; + *err = 0; + return NULL; + } + + /* BigObj is always little-endian. */ + is_big_endian = 0; + + ocr = XNEW (struct simple_object_coff_read); + ocr->magic = simple_object_fetch_little_16 + (bigobj_hdrbuf + + offsetof (struct external_filehdr_bigobj, machine)); + ocr->is_big_endian = 0; + ocr->is_bigobj = 1; + ocr->nscns = simple_object_fetch_little_32 + (bigobj_hdrbuf + + offsetof (struct external_filehdr_bigobj, nscns)); + ocr->symptr = simple_object_fetch_little_32 + (bigobj_hdrbuf + + offsetof (struct external_filehdr_bigobj, symptr)); + ocr->nsyms = simple_object_fetch_little_32 + (bigobj_hdrbuf + + offsetof (struct external_filehdr_bigobj, nsyms)); + ocr->flags = simple_object_fetch_little_32 + (bigobj_hdrbuf + + offsetof (struct external_filehdr_bigobj, flags)); + ocr->scnhdr_offset = sizeof (struct external_filehdr_bigobj); + + return (void *) ocr; + } + + /* Regular COFF. */ is_big_endian = coff_magic[i].is_big_endian; magic = is_big_endian ? magic_big : magic_little; @@ -270,7 +403,7 @@ simple_object_coff_match (unsigned char header[SIMPLE_OBJECT_MATCH_HEADER_LEN], ? simple_object_fetch_big_32 : simple_object_fetch_little_32); - if (!simple_object_internal_read (descriptor, offset, hdrbuf, sizeof hdrbuf, + if (!simple_object_internal_read (descriptor, offset, hdrbuf, sizeof (struct external_filehdr), errmsg, err)) return NULL; @@ -285,6 +418,7 @@ simple_object_coff_match (unsigned char header[SIMPLE_OBJECT_MATCH_HEADER_LEN], ocr = XNEW (struct simple_object_coff_read); ocr->magic = magic; ocr->is_big_endian = is_big_endian; + ocr->is_bigobj = 0; ocr->nscns = fetch_16 (hdrbuf + offsetof (struct external_filehdr, f_nscns)); ocr->symptr = fetch_32 (hdrbuf + offsetof (struct external_filehdr, f_symptr)); @@ -309,9 +443,13 @@ simple_object_coff_read_strtab (simple_object_read *sobj, size_t *strtab_size, unsigned char strsizebuf[4]; size_t strsize; char *strtab; + size_t sym_size; + + /* Symbol size depends on format. */ + sym_size = ocr->is_bigobj ? sizeof (struct external_syment_bigobj) + : sizeof (struct external_syment); - strtab_offset = sobj->offset + ocr->symptr - + ocr->nsyms * sizeof (struct external_syment); + strtab_offset = sobj->offset + ocr->symptr + ocr->nsyms * sym_size; if (!simple_object_internal_read (sobj->descriptor, strtab_offset, strsizebuf, 4, errmsg, err)) return NULL; @@ -444,6 +582,7 @@ simple_object_coff_fetch_attributes (simple_object_read *sobj, ret = XNEW (struct simple_object_coff_attributes); ret->magic = ocr->magic; ret->is_big_endian = ocr->is_big_endian; + ret->is_bigobj = ocr->is_bigobj; ret->flags = ocr->flags; return ret; } @@ -466,7 +605,9 @@ simple_object_coff_attributes_merge (void *todata, void *fromdata, int *err) struct simple_object_coff_attributes *from = (struct simple_object_coff_attributes *) fromdata; - if (to->magic != from->magic || to->is_big_endian != from->is_big_endian) + if (to->magic != from->magic + || to->is_big_endian != from->is_big_endian + || to->is_bigobj != from->is_bigobj) { *err = 0; return "COFF object format mismatch"; @@ -500,6 +641,52 @@ simple_object_coff_start_write (void *attributes_data, return ret; } +/* Write out a BigObj COFF filehdr. */ + +static int +simple_object_coff_write_filehdr_bigobj (simple_object_write *sobj, + int descriptor, + unsigned int nscns, + size_t symtab_offset, + unsigned int nsyms, + const char **errmsg, int *err) +{ + struct simple_object_coff_attributes *attrs = + (struct simple_object_coff_attributes *) sobj->data; + unsigned char hdrbuf[sizeof (struct external_filehdr_bigobj)]; + unsigned char *hdr; + void (*set_16) (unsigned char *, unsigned short); + void (*set_32) (unsigned char *, unsigned int); + + hdr = &hdrbuf[0]; + + /* BigObj is always little-endian. */ + set_16 = simple_object_set_little_16; + set_32 = simple_object_set_little_32; + + memset (hdr, 0, sizeof (struct external_filehdr_bigobj)); + + /* Set BigObj signatures. */ + set_16 (hdr + offsetof (struct external_filehdr_bigobj, sig1), 0); + set_16 (hdr + offsetof (struct external_filehdr_bigobj, sig2), 0xFFFF); + set_16 (hdr + offsetof (struct external_filehdr_bigobj, version), 2); + set_16 (hdr + offsetof (struct external_filehdr_bigobj, machine), + attrs->magic); + /* timdat left as zero. */ + /* Copy ClassID. */ + memcpy (hdr + offsetof (struct external_filehdr_bigobj, classid), + bigobj_magic, 16); + /* sizeofdata, flags, metadatasize, metadataoffset left as zero. */ + set_32 (hdr + offsetof (struct external_filehdr_bigobj, nscns), nscns); + set_32 (hdr + offsetof (struct external_filehdr_bigobj, symptr), + symtab_offset); + set_32 (hdr + offsetof (struct external_filehdr_bigobj, nsyms), nsyms); + + return simple_object_internal_write (descriptor, 0, hdrbuf, + sizeof (struct external_filehdr_bigobj), + errmsg, err); +} + /* Write out a COFF filehdr. */ static int @@ -618,14 +805,16 @@ simple_object_coff_write_to_file (simple_object_write *sobj, int descriptor, what 'gas' uses when told to assemble from stdin. */ const char *source_filename = "fake"; size_t sflen; - union - { - struct external_syment sym; - union external_auxent aux; - } syms[2]; + size_t symsize; void (*set_16) (unsigned char *, unsigned short); void (*set_32) (unsigned char *, unsigned int); + /* Determine symbol size based on format. */ + if (attrs->is_bigobj) + symsize = sizeof (struct external_syment_bigobj); + else + symsize = sizeof (struct external_syment); + set_16 = (attrs->is_big_endian ? simple_object_set_big_16 : simple_object_set_little_16); @@ -637,7 +826,10 @@ simple_object_coff_write_to_file (simple_object_write *sobj, int descriptor, for (section = sobj->sections; section != NULL; section = section->next) ++nscns; - scnhdr_offset = sizeof (struct external_filehdr); + if (attrs->is_bigobj) + scnhdr_offset = sizeof (struct external_filehdr_bigobj); + else + scnhdr_offset = sizeof (struct external_filehdr); offset = scnhdr_offset + nscns * sizeof (struct external_scnhdr); name_offset = 4; for (section = sobj->sections; section != NULL; section = section->next) @@ -693,91 +885,198 @@ simple_object_coff_write_to_file (simple_object_write *sobj, int descriptor, symtab_offset = offset; /* Advance across space reserved for symbol table to locate start of string table. */ - offset += nsyms * sizeof (struct external_syment); + offset += nsyms * symsize; /* Write out file symbol. */ - memset (&syms[0], 0, sizeof (syms)); - strcpy ((char *)&syms[0].sym.e.e_name[0], ".file"); - set_16 (&syms[0].sym.e_scnum[0], IMAGE_SYM_DEBUG); - set_16 (&syms[0].sym.e_type[0], IMAGE_SYM_TYPE); - syms[0].sym.e_sclass[0] = IMAGE_SYM_CLASS_FILE; - syms[0].sym.e_numaux[0] = 1; - /* The name need not be nul-terminated if it fits into the x_fname field - directly, but must be if it has to be placed into the string table. */ - sflen = strlen (source_filename); - if (sflen <= E_FILNMLEN) - memcpy (&syms[1].aux.x_file.x_fname[0], source_filename, sflen); - else + if (attrs->is_bigobj) { - set_32 (&syms[1].aux.x_file.x_n.x_offset[0], name_offset); - if (!simple_object_internal_write (descriptor, offset + name_offset, - ((const unsigned char *) - source_filename), - sflen + 1, &errmsg, err)) + union + { + struct external_syment_bigobj sym; + union external_auxent_bigobj aux; + } syms[2]; + + memset (&syms[0], 0, sizeof (syms)); + strcpy ((char *)&syms[0].sym.e.e_name[0], ".file"); + set_32 (&syms[0].sym.e_scnum[0], IMAGE_SYM_DEBUG); + set_16 (&syms[0].sym.e_type[0], IMAGE_SYM_TYPE); + syms[0].sym.e_sclass[0] = IMAGE_SYM_CLASS_FILE; + syms[0].sym.e_numaux[0] = 1; + /* The name need not be nul-terminated if it fits into the x_fname field + directly, but must be if it has to be placed into the string table. */ + sflen = strlen (source_filename); + if (sflen <= E_FILNMLEN) + memcpy (&syms[1].aux.x_file.x_fname[0], source_filename, sflen); + else + { + set_32 (&syms[1].aux.x_file.x_n.x_offset[0], name_offset); + if (!simple_object_internal_write (descriptor, offset + name_offset, + ((const unsigned char *) + source_filename), + sflen + 1, &errmsg, err)) + return errmsg; + name_offset += strlen (source_filename) + 1; + } + if (!simple_object_internal_write (descriptor, symtab_offset, + (const unsigned char *) &syms[0], + sizeof (syms), &errmsg, err)) return errmsg; - name_offset += strlen (source_filename) + 1; - } - if (!simple_object_internal_write (descriptor, symtab_offset, - (const unsigned char *) &syms[0], - sizeof (syms), &errmsg, err)) - return errmsg; - - /* Write the string table length, followed by the strings and section - symbols in step with each other. */ - set_32 (strsizebuf, name_offset); - if (!simple_object_internal_write (descriptor, offset, strsizebuf, 4, - &errmsg, err)) - return errmsg; - name_offset = 4; - secsym_offset = symtab_offset + sizeof (syms); - memset (&syms[0], 0, sizeof (syms)); - set_16 (&syms[0].sym.e_type[0], IMAGE_SYM_TYPE); - syms[0].sym.e_sclass[0] = IMAGE_SYM_CLASS_STATIC; - syms[0].sym.e_numaux[0] = 1; - secnum = 1; + /* Write the string table length, followed by the strings and section + symbols in step with each other. */ + set_32 (strsizebuf, name_offset); + if (!simple_object_internal_write (descriptor, offset, strsizebuf, 4, + &errmsg, err)) + return errmsg; - for (section = sobj->sections; section != NULL; section = section->next) - { - size_t namelen; - size_t scnsize; - struct simple_object_write_section_buffer *buffer; + name_offset = 4; + secsym_offset = symtab_offset + sizeof (syms); + memset (&syms[0], 0, sizeof (syms)); + set_16 (&syms[0].sym.e_type[0], IMAGE_SYM_TYPE); + syms[0].sym.e_sclass[0] = IMAGE_SYM_CLASS_STATIC; + syms[0].sym.e_numaux[0] = 1; + secnum = 1; - namelen = strlen (section->name); - set_16 (&syms[0].sym.e_scnum[0], secnum++); - scnsize = 0; - for (buffer = section->buffers; buffer != NULL; buffer = buffer->next) - scnsize += buffer->size; - set_32 (&syms[1].aux.x_scn.x_scnlen[0], scnsize); - if (namelen > SCNNMLEN) + for (section = sobj->sections; section != NULL; section = section->next) { - set_32 (&syms[0].sym.e.e.e_zeroes[0], 0); - set_32 (&syms[0].sym.e.e.e_offset[0], name_offset); - if (!simple_object_internal_write (descriptor, offset + name_offset, - ((const unsigned char *) - section->name), - namelen + 1, &errmsg, err)) + size_t namelen; + size_t scnsize; + struct simple_object_write_section_buffer *buffer; + + namelen = strlen (section->name); + set_32 (&syms[0].sym.e_scnum[0], secnum++); + scnsize = 0; + for (buffer = section->buffers; buffer != NULL; buffer = buffer->next) + scnsize += buffer->size; + set_32 (&syms[1].aux.x_scn.x_scnlen[0], scnsize); + if (namelen > SCNNMLEN) + { + set_32 (&syms[0].sym.e.e.e_zeroes[0], 0); + set_32 (&syms[0].sym.e.e.e_offset[0], name_offset); + if (!simple_object_internal_write (descriptor, offset + name_offset, + ((const unsigned char *) + section->name), + namelen + 1, &errmsg, err)) + return errmsg; + name_offset += namelen + 1; + } + else + { + memcpy (&syms[0].sym.e.e_name[0], section->name, + strlen (section->name)); + memset (&syms[0].sym.e.e_name[strlen (section->name)], 0, + E_SYMNMLEN - strlen (section->name)); + } + + if (!simple_object_internal_write (descriptor, secsym_offset, + (const unsigned char *) &syms[0], + sizeof (syms), &errmsg, err)) return errmsg; - name_offset += namelen + 1; + secsym_offset += sizeof (syms); } + } + else + { + /* Regular COFF. */ + union + { + struct external_syment sym; + union external_auxent aux; + } syms[2]; + + memset (&syms[0], 0, sizeof (syms)); + strcpy ((char *)&syms[0].sym.e.e_name[0], ".file"); + set_16 (&syms[0].sym.e_scnum[0], IMAGE_SYM_DEBUG); + set_16 (&syms[0].sym.e_type[0], IMAGE_SYM_TYPE); + syms[0].sym.e_sclass[0] = IMAGE_SYM_CLASS_FILE; + syms[0].sym.e_numaux[0] = 1; + /* The name need not be nul-terminated if it fits into the x_fname field + directly, but must be if it has to be placed into the string table. */ + sflen = strlen (source_filename); + if (sflen <= E_FILNMLEN) + memcpy (&syms[1].aux.x_file.x_fname[0], source_filename, sflen); else { - memcpy (&syms[0].sym.e.e_name[0], section->name, - strlen (section->name)); - memset (&syms[0].sym.e.e_name[strlen (section->name)], 0, - E_SYMNMLEN - strlen (section->name)); + set_32 (&syms[1].aux.x_file.x_n.x_offset[0], name_offset); + if (!simple_object_internal_write (descriptor, offset + name_offset, + ((const unsigned char *) + source_filename), + sflen + 1, &errmsg, err)) + return errmsg; + name_offset += strlen (source_filename) + 1; } - - if (!simple_object_internal_write (descriptor, secsym_offset, + if (!simple_object_internal_write (descriptor, symtab_offset, (const unsigned char *) &syms[0], sizeof (syms), &errmsg, err)) return errmsg; - secsym_offset += sizeof (syms); + + /* Write the string table length, followed by the strings and section + symbols in step with each other. */ + set_32 (strsizebuf, name_offset); + if (!simple_object_internal_write (descriptor, offset, strsizebuf, 4, + &errmsg, err)) + return errmsg; + + name_offset = 4; + secsym_offset = symtab_offset + sizeof (syms); + memset (&syms[0], 0, sizeof (syms)); + set_16 (&syms[0].sym.e_type[0], IMAGE_SYM_TYPE); + syms[0].sym.e_sclass[0] = IMAGE_SYM_CLASS_STATIC; + syms[0].sym.e_numaux[0] = 1; + secnum = 1; + + for (section = sobj->sections; section != NULL; section = section->next) + { + size_t namelen; + size_t scnsize; + struct simple_object_write_section_buffer *buffer; + + namelen = strlen (section->name); + set_16 (&syms[0].sym.e_scnum[0], secnum++); + scnsize = 0; + for (buffer = section->buffers; buffer != NULL; buffer = buffer->next) + scnsize += buffer->size; + set_32 (&syms[1].aux.x_scn.x_scnlen[0], scnsize); + if (namelen > SCNNMLEN) + { + set_32 (&syms[0].sym.e.e.e_zeroes[0], 0); + set_32 (&syms[0].sym.e.e.e_offset[0], name_offset); + if (!simple_object_internal_write (descriptor, offset + name_offset, + ((const unsigned char *) + section->name), + namelen + 1, &errmsg, err)) + return errmsg; + name_offset += namelen + 1; + } + else + { + memcpy (&syms[0].sym.e.e_name[0], section->name, + strlen (section->name)); + memset (&syms[0].sym.e.e_name[strlen (section->name)], 0, + E_SYMNMLEN - strlen (section->name)); + } + + if (!simple_object_internal_write (descriptor, secsym_offset, + (const unsigned char *) &syms[0], + sizeof (syms), &errmsg, err)) + return errmsg; + secsym_offset += sizeof (syms); + } } - if (!simple_object_coff_write_filehdr (sobj, descriptor, nscns, - symtab_offset, nsyms, &errmsg, err)) - return errmsg; + if (attrs->is_bigobj) + { + if (!simple_object_coff_write_filehdr_bigobj (sobj, descriptor, nscns, + symtab_offset, nsyms, + &errmsg, err)) + return errmsg; + } + else + { + if (!simple_object_coff_write_filehdr (sobj, descriptor, nscns, + symtab_offset, nsyms, &errmsg, err)) + return errmsg; + } return NULL; } |