From patchwork Thu Jan 11 09:05:05 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Pierre-Marie de Rodat X-Patchwork-Id: 858940 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-470786-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="r3N0qS6q"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3zHKj11s93z9t3F for ; Thu, 11 Jan 2018 20:05:25 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=AqfNST/A+y6uzRmf2lWLhO+V/+g/0+IBZ/3VsgBRxKu4Lc/05T tEgTuEbQJFUWzhGHOwrt2uUIztFNQ6WGzShcsRm7ozbUqAoLp8TR4CDivDwC4YL0 J0obQHqKhABOmoSzrQnuFmIXsXC3MKgIxhfW6BVJcCRcGOMS3gxVnUw/Q= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=gD5cbYKvgbzfYTtD6tgS4ZysunU=; b=r3N0qS6qvtXg1RNZdiR9 8OXC7bRzOZrZcKfKhdG7YLCWGMKkEAG4E1O8fcK33KUPV4NzHOeC9vxXqH/g5o74 bVA4AJ3E8yC1Uxn09S6YDaUMAznqHR1ri7+8BHrVde70AThuy958qYvMcmrmddUV vDkITCaAwl9clsacTCBiAgs= Received: (qmail 16965 invoked by alias); 11 Jan 2018 09:05:15 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 16817 invoked by uid 89); 11 Jan 2018 09:05:14 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-11.9 required=5.0 tests=BAYES_00, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=Nam, Simplified, rte, (unknown) X-HELO: rock.gnat.com Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 11 Jan 2018 09:05:06 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 3C2A7117BC0; Thu, 11 Jan 2018 04:05:05 -0500 (EST) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id 8BxShwt5favz; Thu, 11 Jan 2018 04:05:05 -0500 (EST) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 2A9B0117BBE; Thu, 11 Jan 2018 04:05:05 -0500 (EST) Received: by tron.gnat.com (Postfix, from userid 4862) id 2933350B; Thu, 11 Jan 2018 04:05:05 -0500 (EST) Date: Thu, 11 Jan 2018 04:05:05 -0500 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Patrick Bernardi Subject: [Ada] Aspect/pragma Secondary_Stack_Size can evaluate non-literals as zero Message-ID: <20180111090505.GA102919@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes This patch fixes the problem of aspect/pragma Secondary_Stack_Size expressions with non-literals evaluating as zero in static secondary stacks allocations. The aspect Secondary_Stack_Size is now converted to a pragma instead of an attribute as the attribute does not have visibility on the discriminant. Additionally, the discriminant of the corresponding record type is now referenced if the pragma expression contains a discriminant. No simple test available as the problem only impacts programs when System.Parameters.Sec_Stack_Dynamic = False Tested on x86_64-pc-linux-gnu, committed on trunk 2018-01-11 Patrick Bernardi gcc/ada/ * exp_ch9.adb (Expand_N_Task_Type_Declaration): Simplified Secondary_Stack_Size handling as a pragma is now generated for the corresponding aspect instead of an attribute. Pragma expression is relocated instead of evaluated. Discriminant of the corresponding record type is referenced rather than the type discriminant. (Create_Secondary_Stack_For_Task, Make_Task_Create_Call): Update Secondary_Stack_Size rep item checks to only look for the pragma rep. * sem_ch13.adb (Analyze_One_Aspect): Transform Aspect_Secondary_Stack_Size into a pragma instead of an attribute because the attribute does not have visibility on a task type's discriminants when the type's definition is expanded. (Analyze_Attribute_Definition_Clause): Remove handling of Attribute_Secondary_Stack_Size. * snames.adb-tmpl, snames.ads-tmpl: Remove Attribute_Secondary_Stack_Size, no longer used. --- gcc/ada/exp_ch9.adb +++ gcc/ada/exp_ch9.adb @@ -5437,7 +5437,7 @@ package body Exp_Ch9 is (Restriction_Active (No_Implicit_Heap_Allocations) or else Restriction_Active (No_Implicit_Task_Allocations)) and then not Restriction_Active (No_Secondary_Stack) - and then Has_Rep_Item + and then Has_Rep_Pragma (T, Name_Secondary_Stack_Size, Check_Parents => False); end Create_Secondary_Stack_For_Task; @@ -11933,7 +11933,7 @@ package body Exp_Ch9 is Set_Analyzed (Task_Size); else - Task_Size := Relocate_Node (Expr_N); + Task_Size := New_Copy_Tree (Expr_N); end if; end; @@ -11971,29 +11971,35 @@ package body Exp_Ch9 is if Create_Secondary_Stack_For_Task (TaskId) then declare - Ritem : Node_Id; - Size_Expr : Node_Id; + Stack_Size : Node_Id; - begin - -- First extract the secondary stack size from the task type's - -- representation aspect. + Size_Expr : constant Node_Id := + Expression (First ( + Pragma_Argument_Associations ( + Get_Rep_Pragma (TaskId, + Name_Secondary_Stack_Size)))); - Ritem := - Get_Rep_Item - (TaskId, Name_Secondary_Stack_Size, Check_Parents => False); + begin + -- The secondary stack is defined inside the corresponding + -- record. Therefore if the size of the stack is set by means + -- of a discriminant, we must reference the discriminant of the + -- corresponding record type. - -- Get Secondary_Stack_Size expression. Can be a pragma or aspect. + if Nkind (Size_Expr) in N_Has_Entity + and then Present (Discriminal_Link (Entity (Size_Expr))) + then + Stack_Size := + New_Occurrence_Of + (CR_Discriminant (Discriminal_Link (Entity (Size_Expr))), + Loc); + Set_Parent (Stack_Size, Parent (Size_Expr)); + Set_Etype (Stack_Size, Etype (Size_Expr)); + Set_Analyzed (Stack_Size); - if Nkind (Ritem) = N_Pragma then - Size_Expr := - Expression - (First (Pragma_Argument_Associations (Ritem))); else - Size_Expr := Expression (Ritem); + Stack_Size := New_Copy_Tree (Size_Expr); end if; - pragma Assert (Compile_Time_Known_Value (Size_Expr)); - -- Create the secondary stack for the task Decl_SS := @@ -12010,8 +12016,8 @@ package body Exp_Ch9 is Constraint => Make_Index_Or_Discriminant_Constraint (Loc, Constraints => New_List ( - Make_Integer_Literal (Loc, - Expr_Value (Size_Expr))))))); + Convert_To (RTE (RE_Size_Type), + Stack_Size)))))); Append_To (Cdecls, Decl_SS); end; @@ -12052,16 +12058,16 @@ package body Exp_Ch9 is Expression => Convert_To (RTE (RE_Size_Type), - Relocate_Node ( + New_Copy_Tree ( Expression (First ( Pragma_Argument_Associations ( Get_Rep_Pragma (TaskId, Name_Storage_Size)))))))); end if; -- Add the _Secondary_Stack_Size component if a Secondary_Stack_Size - -- rep item is present. + -- pragma is present. - if Has_Rep_Item + if Has_Rep_Pragma (TaskId, Name_Secondary_Stack_Size, Check_Parents => False) then Append_To (Cdecls, @@ -12135,7 +12141,7 @@ package body Exp_Ch9 is Expression => Convert_To (RTE (RE_Time_Span), - Relocate_Node ( + New_Copy_Tree ( Expression (First ( Pragma_Argument_Associations ( Get_Relative_Deadline_Pragma (Taskdef)))))))); @@ -14246,15 +14252,15 @@ package body Exp_Ch9 is end if; -- Secondary_Stack_Size parameter. Set RE_Unspecified_Size unless there - -- is a Secondary_Stack_Size rep item, in which case take the value from - -- the rep item. If the restriction No_Secondary_Stack is active then a + -- is a Secondary_Stack_Size pragma, in which case take the value from + -- the pragma. If the restriction No_Secondary_Stack is active then a -- size of 0 is passed regardless to prevent the allocation of the -- unused stack. if Restriction_Active (No_Secondary_Stack) then Append_To (Args, Make_Integer_Literal (Loc, 0)); - elsif Has_Rep_Item + elsif Has_Rep_Pragma (Ttyp, Name_Secondary_Stack_Size, Check_Parents => False) then Append_To (Args,--- gcc/ada/sem_ch13.adb +++ gcc/ada/sem_ch13.adb @@ -2210,7 +2210,6 @@ package body Sem_Ch13 is | Aspect_Output | Aspect_Read | Aspect_Scalar_Storage_Order - | Aspect_Secondary_Stack_Size | Aspect_Simple_Storage_Pool | Aspect_Size | Aspect_Small @@ -3205,6 +3204,27 @@ package body Sem_Ch13 is end; end if; + -- Secondary_Stack_Size + + -- Aspect Secondary_Stack_Size needs to be converted into a + -- pragma for two reasons: the attribute is not analyzed until + -- after the expansion of the task type declaration and the + -- attribute does not have visibility on the discriminant. + + when Aspect_Secondary_Stack_Size => + Make_Aitem_Pragma + (Pragma_Argument_Associations => New_List ( + Make_Pragma_Argument_Association (Loc, + Expression => Relocate_Node (Expr))), + Pragma_Name => + Name_Secondary_Stack_Size); + + Decorate (Aspect, Aitem); + Insert_Pragma (Aitem); + goto Continue; + + -- Volatile_Function + -- Aspect Volatile_Function is never delayed because it is -- equivalent to a source pragma which appears after the -- related subprogram. @@ -5851,46 +5871,6 @@ package body Sem_Ch13 is Set_SSO_Set_High_By_Default (Base_Type (U_Ent), False); end if; - -------------------------- - -- Secondary_Stack_Size -- - -------------------------- - - when Attribute_Secondary_Stack_Size => - - -- Secondary_Stack_Size attribute definition clause not allowed - -- except from aspect specification. - - if From_Aspect_Specification (N) then - if not Is_Task_Type (U_Ent) then - Error_Msg_N - ("Secondary Stack Size can only be defined for task", Nam); - - elsif Duplicate_Clause then - null; - - else - Check_Restriction (No_Secondary_Stack, Expr); - - -- The expression must be analyzed in the special manner - -- described in "Handling of Default and Per-Object - -- Expressions" in sem.ads. - - -- The visibility to the discriminants must be restored - - Push_Scope_And_Install_Discriminants (U_Ent); - Preanalyze_Spec_Expression (Expr, Any_Integer); - Uninstall_Discriminants_And_Pop_Scope (U_Ent); - - if not Is_OK_Static_Expression (Expr) then - Check_Restriction (Static_Storage_Size, Expr); - end if; - end if; - - else - Error_Msg_N - ("attribute& cannot be set with definition clause", N); - end if; - ---------- -- Size -- ------------- gcc/ada/snames.adb-tmpl +++ gcc/ada/snames.adb-tmpl @@ -134,8 +134,6 @@ package body Snames is return Attribute_Dispatching_Domain; elsif N = Name_Interrupt_Priority then return Attribute_Interrupt_Priority; - elsif N = Name_Secondary_Stack_Size then - return Attribute_Secondary_Stack_Size; else return Attribute_Id'Val (N - First_Attribute_Name); end if;--- gcc/ada/snames.ads-tmpl +++ gcc/ada/snames.ads-tmpl @@ -1706,11 +1706,10 @@ package Snames is Attribute_CPU, Attribute_Dispatching_Domain, - Attribute_Interrupt_Priority, - Attribute_Secondary_Stack_Size); + Attribute_Interrupt_Priority); subtype Internal_Attribute_Id is Attribute_Id range - Attribute_CPU .. Attribute_Secondary_Stack_Size; + Attribute_CPU .. Attribute_Interrupt_Priority; type Attribute_Class_Array is array (Attribute_Id) of Boolean; -- Type used to build attribute classification flag arrays