diff options
| -rw-r--r-- | gcc/ada/exp_ch6.adb | 30 | ||||
| -rw-r--r-- | gcc/ada/exp_intr.adb | 17 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 87 |
3 files changed, 91 insertions, 43 deletions
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index be9463b..0b6447aa 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -1051,7 +1051,7 @@ package body Exp_Ch6 is end if; end if; - -- The call node itself is re-analyzed in Expand_Call. + -- The call node itself is re-analyzed in Expand_Call end Expand_Actuals; @@ -1974,6 +1974,10 @@ package body Exp_Ch6 is -- appropriate expansion to the corresponding tree node and we -- are all done (since after that the call is gone!) + -- In the case where the intrinsic is to be processed by the back end, + -- the call to Expand_Intrinsic_Call will do nothing, which is fine, + -- since the idea in this case is to pass the call unchanged. + if Is_Intrinsic_Subprogram (Subp) then Expand_Intrinsic_Call (N, Subp); return; @@ -2300,7 +2304,7 @@ package body Exp_Ch6 is Temp_Typ : Entity_Id; procedure Make_Exit_Label; - -- Build declaration for exit label to be used in Return statements. + -- Build declaration for exit label to be used in Return statements function Process_Formals (N : Node_Id) return Traverse_Result; -- Replace occurrence of a formal with the corresponding actual, or @@ -2331,7 +2335,7 @@ package body Exp_Ch6 is procedure Make_Exit_Label is begin - -- Create exit label for subprogram, if one doesn't exist yet. + -- Create exit label for subprogram if one does not exist yet if No (Exit_Lab) then Lab_Id := Make_Identifier (Loc, New_Internal_Name ('L')); @@ -2509,15 +2513,13 @@ package body Exp_Ch6 is elsif Nkind (N) = N_Identifier and then Nkind (Parent (Entity (N))) = N_Object_Declaration then - - -- The block assigns the result of the call to the temporary. + -- The block assigns the result of the call to the temporary Insert_After (Parent (Entity (N)), Blk); elsif Nkind (Parent (N)) = N_Assignment_Statement and then Is_Entity_Name (Name (Parent (N))) then - -- Replace assignment with the block declare @@ -2660,7 +2662,7 @@ package body Exp_Ch6 is Set_Declarations (Blk, New_List); end if; - -- If this is a derived function, establish the proper return type. + -- If this is a derived function, establish the proper return type if Present (Orig_Subp) and then Orig_Subp /= Subp @@ -2797,7 +2799,7 @@ package body Exp_Ch6 is Targ := Name (Parent (N)); else - -- Replace call with temporary, and create its declaration. + -- Replace call with temporary and create its declaration Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('C')); @@ -2815,7 +2817,7 @@ package body Exp_Ch6 is end if; end if; - -- Traverse the tree and replace formals with actuals or their thunks. + -- Traverse the tree and replace formals with actuals or their thunks. -- Attach block to tree before analysis and rewriting. Replace_Formals (Blk); @@ -2879,7 +2881,7 @@ package body Exp_Ch6 is Restore_Env; - -- Cleanup mapping between formals and actuals, for other expansions. + -- Cleanup mapping between formals and actuals for other expansions F := First_Formal (Subp); @@ -3493,9 +3495,9 @@ package body Exp_Ch6 is end loop; end if; - -- For a function, we must deal with the case where there is at - -- least one missing return. What we do is to wrap the entire body - -- of the function in a block: + -- For a function, we must deal with the case where there is at least + -- one missing return. What we do is to wrap the entire body of the + -- function in a block: -- begin -- ... @@ -3732,7 +3734,7 @@ package body Exp_Ch6 is if Is_Subprogram (Proc) and then Proc /= Corr then - -- Protected function or procedure. + -- Protected function or procedure Set_Entity (Rec, Param); diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index 7f99eb5..8f41704 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -281,12 +281,21 @@ package body Exp_Intr is then Expand_Source_Info (N, Nam); - else - -- Only other possibility is a renaming, in which case we expand - -- the call to the original operation (which must be intrinsic). + -- If we have a renaming, expand the call to the original operation, + -- which must itself be intrinsic, since renaming requires matching + -- conventions and this has already been checked. - pragma Assert (Present (Alias (E))); + elsif Present (Alias (E)) then Expand_Intrinsic_Call (N, Alias (E)); + + -- The only other case is where an external name was specified, + -- since this is the only way that an otherwise unrecognized + -- name could escape the checking in Sem_Prag. Nothing needs + -- to be done in such a case, since we pass such a call to the + -- back end unchanged. + + else + null; end if; end Expand_Intrinsic_Call; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index e21038f..9691ebb 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -2965,13 +2965,34 @@ package body Sem_Prag is else Set_Imported (Def_Id); - -- If Import intrinsic, set intrinsic flag and verify - -- that it is known as such. + -- Special processing for Convention_Intrinsic if C = Convention_Intrinsic then + + -- Link_Name argument not allowed for intrinsic + + if Present (Arg3) + and then Chars (Arg3) = Name_Link_Name + then + Arg4 := Arg3; + end if; + + if Present (Arg4) then + Error_Pragma_Arg + ("Link_Name argument not allowed for " & + "Import Intrinsic", + Arg4); + end if; + Set_Is_Intrinsic_Subprogram (Def_Id); - Check_Intrinsic_Subprogram - (Def_Id, Expression (Arg2)); + + -- If no external name is present, then check that + -- this is a valid intrinsic subprogram. If an external + -- name is present, then this is handled by the back end. + + if No (Arg3) then + Check_Intrinsic_Subprogram (Def_Id, Expression (Arg2)); + end if; end if; -- All interfaced procedures need an external symbol @@ -3073,24 +3094,29 @@ package body Sem_Prag is procedure Set_Inline_Flags (Subp : Entity_Id); -- Sets Is_Inlined and Has_Pragma_Inline flags for Subp - function Cannot_Inline (Subp : Entity_Id) return Boolean; - -- Do not set the inline flag if body is available and contains - -- exception handlers, to prevent undefined symbols at link time. - -- Emit warning if front-end inlining is enabled and the pragma - -- appears too late. + function Inlining_Not_Possible (Subp : Entity_Id) return Boolean; + -- Returns True if it can be determined at this stage that inlining + -- is not possible, for examle if the body is available and contains + -- exception handlers, we prevent inlining, since otherwise we can + -- get undefined symbols at link time. This function also emits a + -- warning if front-end inlining is enabled and the pragma appears + -- too late. + -- ??? is business with link symbols still valid, or does it relate + -- to front end ZCX which is being phased out ??? - ------------------- - -- Cannot_Inline -- - ------------------- + --------------------------- + -- Inlining_Not_Possible -- + --------------------------- - function Cannot_Inline (Subp : Entity_Id) return Boolean is - Decl : constant Node_Id := Unit_Declaration_Node (Subp); + function Inlining_Not_Possible (Subp : Entity_Id) return Boolean is + Decl : constant Node_Id := Unit_Declaration_Node (Subp); + Stats : Node_Id; begin if Nkind (Decl) = N_Subprogram_Body then - return - Present - (Exception_Handlers (Handled_Statement_Sequence (Decl))); + Stats := Handled_Statement_Sequence (Decl); + return Present (Exception_Handlers (Stats)) + or else Present (At_End_Proc (Stats)); elsif Nkind (Decl) = N_Subprogram_Declaration and then Present (Corresponding_Body (Decl)) @@ -3112,18 +3138,22 @@ package body Sem_Prag is return False; else + Stats := + Handled_Statement_Sequence + (Unit_Declaration_Node (Corresponding_Body (Decl))); + return - Present (Exception_Handlers - (Handled_Statement_Sequence - (Unit_Declaration_Node (Corresponding_Body (Decl))))); + Present (Exception_Handlers (Stats)) + or else Present (At_End_Proc (Stats)); end if; + else -- If body is not available, assume the best, the check is -- performed again when compiling enclosing package bodies. return False; end if; - end Cannot_Inline; + end Inlining_Not_Possible; ----------------- -- Make_Inline -- @@ -3137,8 +3167,10 @@ package body Sem_Prag is if Etype (Subp) = Any_Type then return; - elsif Cannot_Inline (Subp) then - Applies := True; -- Do not treat as an error. + -- If inlining is not possible, for now do not treat as an error + + elsif Inlining_Not_Possible (Subp) then + Applies := True; return; -- Here we have a candidate for inlining, but we must exclude @@ -3277,8 +3309,13 @@ package body Sem_Prag is elsif not Effective and then Warn_On_Redundant_Constructs then - Error_Msg_NE ("pragma Inline for& is redundant?", - N, Entity (Subp_Id)); + if Inlining_Not_Possible (Subp) then + Error_Msg_NE + ("pragma Inline for& is ignored?", N, Entity (Subp_Id)); + else + Error_Msg_NE + ("pragma Inline for& is redundant?", N, Entity (Subp_Id)); + end if; end if; Next (Assoc); |