From b03d3f7390b5744c5fdf54a73fec6a28a8849a1b Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 25 Apr 2017 10:29:46 +0200 Subject: [PATCH] [multiple changes] 2017-04-25 Javier Miranda * exp_ch3.adb (Build_Initialization_Call): Handle subtypes of private types when searching for the underlying full view of a private type. 2017-04-25 Javier Miranda * sem_res.adb (Set_Mixed_Mode_Operand): A universal real conditional expression can appear in a fixed-type context and must be resolved with that context to facilitate the code generation to the backend. 2017-04-25 Ed Schonberg * einfo.adb, einfo.ads (Body_Needed_For_Inlining): New flag, to indicate whether during inline processing, when some unit U1 appears in the context of a unit U2 compiled for instantiation or inlining purposes, the body of U1 needs to be compiled as well. * sem_prag.adb (Process_Inline): Set Body_Needed_For_Inlining if context is a package declaration. * sem_ch12.adb (Analyze_Generic_Subprogram_Declaration, Analyze_Generic_Package_Declaration): ditto. * inline.adb (Analyze_Inlined_Bodies): Check Body_Needed_For_Inlining. 2017-04-25 Ed Schonberg * par.adb (Current_Assign_Node): Global variable use to record the presence of a target_name in the right hand side of the assignment being parsed. * par-ch4.adb (P_Name): If the name is a target_name, mark the enclosing assignment node accordingly. * par-ch5.adb (P_Assignment_Statement): Set Current_Assign_Node appropriately. * sem_ch5.adb (Analyze_Assignment): Disable expansion before analyzing RHS if the statement has target_names. * sem_aggr.adb (Resolve_Iterated_Component_Association): Handle properly choices that are subtype marks. * exp_ch5.adb: Code cleanup. 2017-04-25 Bob Duff * s-memory.adb: Add a comment regarding efficiency. * atree.adb: Fix the assertion, and combine 2 assertions into one, "the source has an extension if and only if the destination does." * sem_ch3.adb, sem_ch13.adb: Address ??? comments. 2017-04-25 Arnaud Charlet * a-tasatt.adb (Set_Value): Fix handling of 32bits -> 64bits conversion. 2017-04-25 Doug Rupp * init.c (__gnat_error_handler) [vxworks]: Turn on sigtramp handling for ppc64-vx7. * sigtramp-vxworks-target.inc [SIGTRAMP_BODY]: Add section for ppc64-vx7. From-SVN: r247146 --- gcc/ada/ChangeLog | 60 +++++++++++++++++++++++++++++ gcc/ada/a-tasatt.adb | 6 ++- gcc/ada/atree.adb | 8 +--- gcc/ada/einfo.adb | 16 +++++++- gcc/ada/einfo.ads | 13 +++++++ gcc/ada/exp_ch3.adb | 6 +++ gcc/ada/exp_ch5.adb | 8 ++++ gcc/ada/init.c | 2 +- gcc/ada/inline.adb | 10 +++-- gcc/ada/par-ch4.adb | 4 ++ gcc/ada/par-ch5.adb | 2 + gcc/ada/par.adb | 6 +++ gcc/ada/s-memory.adb | 2 + gcc/ada/sem_aggr.adb | 16 +++++++- gcc/ada/sem_ch12.adb | 20 ++++++++++ gcc/ada/sem_ch13.adb | 2 +- gcc/ada/sem_ch3.adb | 2 +- gcc/ada/sem_ch5.adb | 13 ++----- gcc/ada/sem_prag.adb | 11 ++++++ gcc/ada/sem_res.adb | 10 +++++ gcc/ada/sigtramp-vxworks-target.inc | 32 +++++++++++++++ 21 files changed, 224 insertions(+), 25 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d74dfff7e9a..ee46f95f4d5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,63 @@ +2017-04-25 Javier Miranda + + * exp_ch3.adb (Build_Initialization_Call): Handle + subtypes of private types when searching for the underlying full + view of a private type. + +2017-04-25 Javier Miranda + + * sem_res.adb (Set_Mixed_Mode_Operand): A universal + real conditional expression can appear in a fixed-type context + and must be resolved with that context to facilitate the code + generation to the backend. + +2017-04-25 Ed Schonberg + + * einfo.adb, einfo.ads (Body_Needed_For_Inlining): New flag, + to indicate whether during inline processing, when some unit U1 + appears in the context of a unit U2 compiled for instantiation + or inlining purposes, the body of U1 needs to be compiled as well. + * sem_prag.adb (Process_Inline): Set Body_Needed_For_Inlining if + context is a package declaration. + * sem_ch12.adb (Analyze_Generic_Subprogram_Declaration, + Analyze_Generic_Package_Declaration): ditto. + * inline.adb (Analyze_Inlined_Bodies): Check + Body_Needed_For_Inlining. + +2017-04-25 Ed Schonberg + + * par.adb (Current_Assign_Node): Global variable use to record + the presence of a target_name in the right hand side of the + assignment being parsed. + * par-ch4.adb (P_Name): If the name is a target_name, mark the + enclosing assignment node accordingly. + * par-ch5.adb (P_Assignment_Statement): Set Current_Assign_Node + appropriately. + * sem_ch5.adb (Analyze_Assignment): Disable expansion before + analyzing RHS if the statement has target_names. + * sem_aggr.adb (Resolve_Iterated_Component_Association): Handle + properly choices that are subtype marks. + * exp_ch5.adb: Code cleanup. + +2017-04-25 Bob Duff + + * s-memory.adb: Add a comment regarding efficiency. + * atree.adb: Fix the assertion, and combine 2 assertions into one, + "the source has an extension if and only if the destination does." + * sem_ch3.adb, sem_ch13.adb: Address ??? comments. + +2017-04-25 Arnaud Charlet + + * a-tasatt.adb (Set_Value): Fix handling of 32bits -> 64bits + conversion. + +2017-04-25 Doug Rupp + + * init.c (__gnat_error_handler) [vxworks]: Turn on sigtramp + handling for ppc64-vx7. + * sigtramp-vxworks-target.inc + [SIGTRAMP_BODY]: Add section for ppc64-vx7. + 2017-04-25 Arnaud Charlet * ada_get_targ.adb: New file. diff --git a/gcc/ada/a-tasatt.adb b/gcc/ada/a-tasatt.adb index 1eb7d592712..703d1407a98 100644 --- a/gcc/ada/a-tasatt.adb +++ b/gcc/ada/a-tasatt.adb @@ -302,7 +302,11 @@ package body Ada.Task_Attributes is -- No finalization needed, simply set to Val - TT.Attributes (Index) := To_Address (Val); + if Attribute'Size = Integer'Size then + TT.Attributes (Index) := Atomic_Address (To_Int (Val)); + else + TT.Attributes (Index) := To_Address (Val); + end if; else Self_Id := STPO.Self; diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 29251c226aa..9137602b15c 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -767,16 +767,12 @@ package body Atree is -- Deal with copying extension nodes if present. No need to copy flags -- table entries, since they are always zero for extending components. - if Has_Extension (Source) then - pragma Assert (Has_Extension (Destination)); + pragma Assert (Has_Extension (Source) = Has_Extension (Destination)); + if Has_Extension (Source) then for J in 1 .. Num_Extension_Nodes loop Nodes.Table (Destination + J) := Nodes.Table (Source + J); end loop; - - else - pragma Assert (not Has_Extension (Source)); - null; end if; end Copy_Node; diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index e97d1478bb2..e01abddecea 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -615,10 +615,9 @@ package body Einfo is -- Has_Partial_Visible_Refinement Flag296 -- Is_Entry_Wrapper Flag297 -- Is_Underlying_Full_View Flag298 + -- Body_Needed_For_Inlining Flag299 - -- (unused) Flag299 -- (unused) Flag300 - -- (unused) Flag301 -- (unused) Flag302 -- (unused) Flag303 @@ -829,6 +828,12 @@ package body Einfo is return Node19 (Id); end Body_Entity; + function Body_Needed_For_Inlining (Id : E) return B is + begin + pragma Assert (Ekind (Id) = E_Package); + return Flag299 (Id); + end Body_Needed_For_Inlining; + function Body_Needed_For_SAL (Id : E) return B is begin pragma Assert @@ -3861,6 +3866,12 @@ package body Einfo is Set_Node19 (Id, V); end Set_Body_Entity; + procedure Set_Body_Needed_For_Inlining (Id : E; V : B := True) is + begin + pragma Assert (Ekind (Id) = E_Package); + Set_Flag299 (Id, V); + end Set_Body_Needed_For_Inlining; + procedure Set_Body_Needed_For_SAL (Id : E; V : B := True) is begin pragma Assert @@ -9252,6 +9263,7 @@ package body Einfo is W ("Address_Taken", Flag104 (Id)); W ("Body_Needed_For_SAL", Flag40 (Id)); + W ("Body_Needed_For_Inlining", Flag299 (Id)); W ("C_Pass_By_Copy", Flag125 (Id)); W ("Can_Never_Be_Null", Flag38 (Id)); W ("Checks_May_Be_Suppressed", Flag31 (Id)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 5a762abcaee..a08d5d26d21 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -529,6 +529,14 @@ package Einfo is -- units. Indicates that the source for the body must be included -- when the unit is part of a standalone library. +-- Body_Needed_For_Inlining (Flag299) +-- Defined in package entities that are compilation units. Used to +-- determine whether the body unit needs to be compiled when the +-- package declaration appears in the list of units to inline. A body +-- is needed for inline processing if the unit declaration contains +-- functions that carry pragma Inline or Inline_Always, or if it +-- contains a generic unit that requires a body. +-- -- Body_References (Elist16) -- Defined in abstract state entities. Contains an element list of -- references (identifiers) that appear in a package body whose spec @@ -6238,6 +6246,7 @@ package Einfo is -- SPARK_Pragma (Node40) -- SPARK_Aux_Pragma (Node41) -- Delay_Subprogram_Descriptors (Flag50) + -- Body_Needed_For_Inlining (Flag299) -- Body_Needed_For_SAL (Flag40) -- Contains_Ignored_Ghost_Code (Flag279) -- Discard_Names (Flag88) @@ -6880,6 +6889,7 @@ package Einfo is function Block_Node (Id : E) return N; function Body_Entity (Id : E) return E; function Body_Needed_For_SAL (Id : E) return B; + function Body_Needed_For_Inlining (Id : E) return B; function Body_References (Id : E) return L; function C_Pass_By_Copy (Id : E) return B; function Can_Never_Be_Null (Id : E) return B; @@ -7563,6 +7573,7 @@ package Einfo is procedure Set_BIP_Initialization_Call (Id : E; V : N); procedure Set_Block_Node (Id : E; V : N); procedure Set_Body_Entity (Id : E; V : E); + procedure Set_Body_Needed_For_Inlining (Id : E; V : B := True); procedure Set_Body_Needed_For_SAL (Id : E; V : B := True); procedure Set_Body_References (Id : E; V : L); procedure Set_C_Pass_By_Copy (Id : E; V : B := True); @@ -8365,6 +8376,7 @@ package Einfo is pragma Inline (BIP_Initialization_Call); pragma Inline (Block_Node); pragma Inline (Body_Entity); + pragma Inline (Body_Needed_For_Inlining); pragma Inline (Body_Needed_For_SAL); pragma Inline (Body_References); pragma Inline (C_Pass_By_Copy); @@ -8886,6 +8898,7 @@ package Einfo is pragma Inline (Set_BIP_Initialization_Call); pragma Inline (Set_Block_Node); pragma Inline (Set_Body_Entity); + pragma Inline (Set_Body_Needed_For_Inlining); pragma Inline (Set_Body_Needed_For_SAL); pragma Inline (Set_Body_References); pragma Inline (Set_C_Pass_By_Copy); diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 788cf7f0da7..20331794c97 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -1451,6 +1451,12 @@ package body Exp_Ch3 is elsif Is_Generic_Actual_Type (Full_Type) then Full_Type := Base_Type (Full_Type); + elsif Ekind (Full_Type) = E_Private_Subtype + and then (not Has_Discriminants (Full_Type) + or else No (Discriminant_Constraint (Full_Type))) + then + Full_Type := Etype (Full_Type); + -- The loop has recovered the [underlying] full view, stop the -- traversal. diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 6a808a35a30..cd555b42d48 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1638,6 +1638,14 @@ package body Exp_Ch5 is begin if Nkind (N) = N_Target_Name then Rewrite (N, New_Occurrence_Of (Ent, Sloc (N))); + + -- The expression will be reanalyzed when the enclosing assignment + -- is reanalyzed, so reset the entity, which may be a temporary + -- created during analysis, e.g. a loop variable for an iterated + -- component association. + + elsif Is_Entity_Name (N) then + Set_Entity (N, Empty); end if; Set_Analyzed (N, False); diff --git a/gcc/ada/init.c b/gcc/ada/init.c index 07155f02301..e180f3cfb09 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -2005,7 +2005,7 @@ __gnat_error_handler (int sig, siginfo_t *si, void *sc) sigdelset (&mask, sig); sigprocmask (SIG_SETMASK, &mask, NULL); -#if defined (__ARMEL__) || (defined (__PPC__) && !defined (__PPC64__)) || defined (__i386__) || defined (__x86_64__) +#if defined (__ARMEL__) || defined (__PPC__) || defined (__i386__) || defined (__x86_64__) /* On certain targets, kernel mode, we process signals through a Call Frame Info trampoline, voiding the need for myriads of fallback_frame_state variants in the ZCX runtime. We have no simple way to distinguish ZCX diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 78d921a75d7..c20a2df8369 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -744,14 +744,18 @@ package body Inline is Comp_Unit := Parent (Comp_Unit); end loop; - -- Load the body, unless it is the main unit, or is an instance - -- whose body has already been analyzed. + -- Load the body if it exists and contains inlineable entities, + -- unless it is the main unit, or is an instance whose body has + -- already been analyzed. if Present (Comp_Unit) and then Comp_Unit /= Cunit (Main_Unit) and then Body_Required (Comp_Unit) and then (Nkind (Unit (Comp_Unit)) /= N_Package_Declaration - or else No (Corresponding_Body (Unit (Comp_Unit)))) + or else + (No (Corresponding_Body (Unit (Comp_Unit))) + and then Body_Needed_For_Inlining + (Defining_Entity (Unit (Comp_Unit))))) then declare Bname : constant Unit_Name_Type := diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 4e6c8a765dc..d500e58f36e 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -235,6 +235,10 @@ package body Ch4 is if Token = Tok_At_Sign then Scan_Reserved_Identifier (Force_Msg => False); + + if Present (Current_Assign_Node) then + Set_Has_Target_Names (Current_Assign_Node); + end if; end if; Name_Node := Token_Node; diff --git a/gcc/ada/par-ch5.adb b/gcc/ada/par-ch5.adb index 5d8b45ceae5..2d975efff59 100644 --- a/gcc/ada/par-ch5.adb +++ b/gcc/ada/par-ch5.adb @@ -1067,9 +1067,11 @@ package body Ch5 is begin Assign_Node := New_Node (N_Assignment_Statement, Prev_Token_Ptr); + Current_Assign_Node := Assign_Node; Set_Name (Assign_Node, LHS); Set_Expression (Assign_Node, P_Expression_No_Right_Paren); TF_Semicolon; + Current_Assign_Node := Empty; return Assign_Node; end P_Assignment_Statement; diff --git a/gcc/ada/par.adb b/gcc/ada/par.adb index d3c069a04a9..6c39e330dc7 100644 --- a/gcc/ada/par.adb +++ b/gcc/ada/par.adb @@ -595,6 +595,12 @@ function Par (Configuration_Pragmas : Boolean) return List_Id is -- this may not be worth the effort. Also we could deal with the same -- situation for EXIT with a label, but for now don't bother with that. + Current_Assign_Node : Node_Id := Empty; + -- This is the node of the current assignment statement being compiled. + -- It is used to record the presence of target_names on its RHS. This + -- context-dependent trick simplifies the analysis of such nodes, where + -- the RHS must first be analyzed with expansion disabled. + --------------------------------- -- Parsing Routines by Chapter -- --------------------------------- diff --git a/gcc/ada/s-memory.adb b/gcc/ada/s-memory.adb index f419b4716ee..870b68a85cc 100644 --- a/gcc/ada/s-memory.adb +++ b/gcc/ada/s-memory.adb @@ -73,6 +73,8 @@ package body System.Memory is -- return Null_Address, and then we can check for that special value. -- However, that doesn't work on VxWorks, because malloc(size_t'Last) -- prints an unwanted warning message before returning Null_Address. + -- Note that the branch is correctly predicted on modern hardware, so + -- there is negligible overhead. if Size = size_t'Last then raise Storage_Error with "object too large"; diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index efa5d60b6af..223a59fcab8 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -1664,7 +1664,19 @@ package body Sem_Aggr is Others_Present := True; else - Analyze_And_Resolve (Choice, Index_Typ); + Analyze (Choice); + + -- Choice can be a subtype name, a range, or an expression. + + if Is_Entity_Name (Choice) + and then Is_Type (Entity (Choice)) + and then Base_Type (Entity (Choice)) = Base_Type (Index_Typ) + then + null; + + else + Analyze_And_Resolve (Choice, Index_Typ); + end if; end if; Next (Choice); @@ -1681,6 +1693,8 @@ package body Sem_Aggr is -- Decorate the index variable in the current scope. The association -- may have several choices, each one leading to a loop, so we create -- this variable only once to prevent homonyms in this scope. + -- The expression has to be analyzed once the index variable is + -- directly visible. if No (Scope (Id)) then Enter_Name (Id); diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index c43533603be..bc824103ec9 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -3374,6 +3374,14 @@ package body Sem_Ch12 is End_Package_Scope (Id); Exit_Generic_Scope (Id); + -- If the generic appears within a package unit, the body of that unit + -- has to be present for instantiation and inlining. + + if Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Declaration then + Set_Body_Needed_For_Inlining + (Defining_Entity (Unit (Cunit (Current_Sem_Unit)))); + end if; + if Nkind (Parent (N)) /= N_Compilation_Unit then Move_Freeze_Nodes (Id, N, Visible_Declarations (Specification (N))); Move_Freeze_Nodes (Id, N, Private_Declarations (Specification (N))); @@ -3552,6 +3560,16 @@ package body Sem_Ch12 is Set_Body_Required (Parent (N), Unit_Requires_Body (Id)); end if; + -- If the generic appears within a package unit, the body of that unit + -- has to be present for instantiation and inlining. + + if Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Declaration + and then Unit_Requires_Body (Id) + then + Set_Body_Needed_For_Inlining + (Defining_Entity (Unit (Cunit (Current_Sem_Unit)))); + end if; + Set_Categorization_From_Pragmas (N); Validate_Categorization_Dependency (N, Id); @@ -3724,6 +3742,8 @@ package body Sem_Ch12 is -- Turn off style checking in instances. If the check is enabled on the -- generic unit, a warning in an instance would just be noise. If not -- enabled on the generic, then a warning in an instance is just wrong. + -- This must be done after analyzing the actuals, which do come from + -- source and are subject to style checking. Style_Check := False; diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index e796ab3dbf4..ce47fd8433a 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -12754,7 +12754,7 @@ package body Sem_Ch13 is elsif Nkind (N) = N_Identifier and then Chars (N) /= Chars (E) then Find_Direct_Name (N); - if True or else not ASIS_Mode then -- ???? + if not ASIS_Mode then Set_Entity (N, Empty); end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index cc06b92ed33..ed385dd5e0a 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -2574,7 +2574,7 @@ package body Sem_Ch3 is -- rejected. Pending notification we restrict this call to -- ASIS mode. - if False and then ASIS_Mode then -- ???? + if ASIS_Mode then Resolve_Aspects; end if; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index c5f4732d316..8babb8ac251 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -300,6 +300,10 @@ package body Sem_Ch5 is -- Ghost entity. Set the mode now to ensure that any nodes generated -- during analysis and expansion are properly marked as Ghost. + if Has_Target_Names (N) then + Expander_Mode_Save_And_Set (False); + end if; + Mark_And_Set_Ghost_Assignment (N, Mode); Analyze (Rhs); @@ -3546,15 +3550,6 @@ package body Sem_Ch5 is else Set_Has_Target_Names (Parent (Current_LHS)); Set_Etype (N, Etype (Current_LHS)); - - -- Disable expansion for the rest of the analysis of the current - -- right-hand side. The enclosing assignment statement will be - -- rewritten during expansion, together with occurrences of the - -- target name. - - if Expander_Active then - Expander_Mode_Save_And_Set (False); - end if; end if; end Analyze_Target_Name; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 3889d004b73..e9c94198675 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -9112,6 +9112,17 @@ package body Sem_Prag is Next (Assoc); end loop; + + -- If the context is a package declaration, the pragma indicates + -- that inlining will require the presence of the corresponding + -- body. (this may be further refined). + + if not In_Instance + and then Nkind (Unit (Cunit (Current_Sem_Unit))) + = N_Package_Declaration + then + Set_Body_Needed_For_Inlining (Cunit_Entity (Current_Sem_Unit)); + end if; end Process_Inline; ---------------------------- diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 3d6c39583c8..337b1228ab1 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -5353,6 +5353,16 @@ package body Sem_Res is Resolve (Op2, T2); end; + -- A universal real conditional expression can appear in a fixed-type + -- context and must be resolved with that context to facilitate the + -- code generation to the backend. + + elsif Nkind_In (N, N_Case_Expression, N_If_Expression) + and then Etype (N) = Universal_Real + and then Is_Fixed_Point_Type (B_Typ) + then + Resolve (N, B_Typ); + else Resolve (N); end if; diff --git a/gcc/ada/sigtramp-vxworks-target.inc b/gcc/ada/sigtramp-vxworks-target.inc index 722dd31c7b5..8eacfd82ef2 100644 --- a/gcc/ada/sigtramp-vxworks-target.inc +++ b/gcc/ada/sigtramp-vxworks-target.inc @@ -274,6 +274,7 @@ TCR(".cfi_return_column " S(REGNO_PC)) /* Trampoline body block --------------------- */ +#if !defined (__PPC64__) #define SIGTRAMP_BODY \ CR("") \ TCR("# Allocate frame and save the non-volatile") \ @@ -298,6 +299,37 @@ TCR("mtlr %r0") \ TCR("") \ TCR("addi %r1,%r1,16") \ TCR("blr") +#else +#define SIGTRAMP_BODY \ +CR("") \ +TCR("0:") \ +TCR("addis 2,12,.TOC.-0@ha") \ +TCR("addi 2,2,.TOC.-0@l") \ +TCR("# Allocate frame and save the non-volatile") \ +TCR("# registers we're going to modify") \ +TCR("mflr %r0") \ +TCR("std %r0,16(%r1)") \ +TCR("stdu %r1,-32(%r1)") \ +TCR("std %r2,24(%r1)") \ +TCR("std %r" S(CFA_REG) ",8(%r1)") \ +TCR("") \ +TCR("# Setup CFA_REG = context, which we'll retrieve as our CFA value") \ +TCR("mr %r" S(CFA_REG) ", %r7") \ +TCR("") \ +TCR("# Call the real handler. The signo, siginfo and sigcontext") \ +TCR("# arguments are the same as those we received in r3, r4 and r5") \ +TCR("mr %r12,%r6") \ +TCR("mtctr %r6") \ +TCR("bctrl") \ +TCR("") \ +TCR("# Restore our callee-saved items, release our frame and return") \ +TCR("ld %r" S(CFA_REG) ",8(%r1)") \ +TCR("ld %r2,24(%r1)") \ +TCR("addi %r1,%r1,32") \ +TCR("ld %r0,16(%r1)") \ +TCR("mtlr %r0") \ +TCR("blr") +#endif #elif defined (__ARMEL__) -- 2.30.2