From patchwork Wed Jul 13 10:02:57 2022 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: 56013 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id BFDAD3831373 for ; Wed, 13 Jul 2022 10:05:25 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org BFDAD3831373 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1657706725; bh=2Vx5XGqzGh8+FAXmfzHjrRX5AerRNDmM6moj7r2nD4o=; h=Date:To:Subject:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:Cc:From; b=ACp3JjjDd8UFkM1hjw53nuNgVWqoufw8mPXdhgYhG4r2sn+8Qk7aPG3hM8kxpHtFB M2iH7d7oSeAQ/TJrVqb8trvmCDQvfOwoN021KHaUBxVsI7i4SVZemmPpJJ1Qs2dvu7 iyCuBnltRCdEwCVOpxoD5bcv/5qEtQaDnqv7QnFI= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-ed1-x52e.google.com (mail-ed1-x52e.google.com [IPv6:2a00:1450:4864:20::52e]) by sourceware.org (Postfix) with ESMTPS id AD30F3851AAF for ; Wed, 13 Jul 2022 10:02:59 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org AD30F3851AAF Received: by mail-ed1-x52e.google.com with SMTP id x91so13434320ede.1 for ; Wed, 13 Jul 2022 03:02:59 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20210112; h=x-gm-message-state:date:from:to:cc:subject:message-id:mime-version :content-disposition; bh=2Vx5XGqzGh8+FAXmfzHjrRX5AerRNDmM6moj7r2nD4o=; b=tmdTctmU0mvCJx/d3uqMUgdJTJ31wNXMwUAk/PB4/0kXtxRW3vpEOe4rcTkU1z+oxl ZSceaVKQNsSrbQrhJ0w/jkc/uzM5KC17TD9pYF0ioVXXexFkmaU0bb8VPxKgIss0ZJpY /LWtNUp9Ag/S6PtOCaTl3/erkEzR3uaFV5yfyBqAtpwqOJPm3Gzn83czgs8F2hK0cCK3 RD4VL4oBHkVqLv8p7xFrFRaS5G5GISnb9cTDw2D7KeBK3Og7e9hqrDzVH31K2vXsg9hf 4h8xlOX/RWHs//6EqQH49gYmS8fZuyIcO8nxTYBQ2wsAo67zR9QG79EeU0/zd3rgkDYX A4LQ== X-Gm-Message-State: AJIora+EPy/tpxrAzYWll+Zc6ehFqUzGJL8YRNFz8QuNhFNpx9unIkE4 4vpQSsD/LVFah4mu+/dF0ji4+o9vXYt4ow== X-Google-Smtp-Source: AGRyM1vyK4jFxg9vdbwVg0v0e9Es7T7Bar551Dkdb+OhGpbheFome426oVZyqL99SZQjFnLDTGCp2A== X-Received: by 2002:aa7:c657:0:b0:43a:4a68:bcc5 with SMTP id z23-20020aa7c657000000b0043a4a68bcc5mr3780117edr.337.1657706579220; Wed, 13 Jul 2022 03:02:59 -0700 (PDT) Received: from adacore.com ([45.147.211.82]) by smtp.gmail.com with ESMTPSA id 18-20020a170906201200b00722e50e259asm4729750ejo.102.2022.07.13.03.02.58 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 13 Jul 2022 03:02:58 -0700 (PDT) Date: Wed, 13 Jul 2022 10:02:57 +0000 To: gcc-patches@gcc.gnu.org Subject: [Ada] Add support for defaulted Storage_Model_Type aspect and subaspects Message-ID: <20220713100257.GA994704@adacore.com> MIME-Version: 1.0 Content-Disposition: inline X-Spam-Status: No, score=-12.8 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_FILL_THIS_FORM_SHORT, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Pierre-Marie de Rodat via Gcc-patches From: Pierre-Marie de Rodat Reply-To: Pierre-Marie de Rodat Cc: Gary Dismukes Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" The compiler currently rejects a Storage_Model_Type aspect that is not specified with an aggregate, or that has an aggregate that does not specify all defined "subaspects" (Address_Type, Null_Address, Allocate, etc.). The RFC for this feature defines the aspect to fully default to the native memory model when no aggregate is given, and also allows any subaspects to be specified and others to default in the case where the address type is the native address type (System.Address), whether that address type is explicitly specified or defaulted. This set of changes now supports that defaulting semantics. Note that the subaspect retrieval functions in Sem_Util.Storage_Model_Support (which are called by the compiler back ends) will now return Empty for any subprogram subaspects (Allocate, Deallocate, etc.) that are defaulted in the aspect (that is, in the native model case where the address type is System.Address). Also in the native case, retrieval of defaulted subaspects Address_Type and Null_Address will return the entities for System.Address and System.Null_Address, respectively. Additionally, error checks for multiple associations given for the same subaspect are now done. Tested on x86_64-pc-linux-gnu, committed on trunk gcc/ada/ * aspects.ads (Aspect_Argument): Change the association for Aspect_Storage_Model_Type from Expression to Optional_Expression. * exp_util.ads (Find_Storage_Op): Update comment to indicate that Empty can be returned in the case where a storage-model operation is defaulted. * exp_util.adb (Find_Storage_Op): Allow the function to return Empty in Storage_Model_Type case rather than raising Program_Error, so that Procedure_To_Call fields in N_Allocator and N_Free_Statement nodes will be set to Empty in the defaulted native storage-model case. * sem_ch13.adb: Add with and use of System.Case_Util (and reformat context_clause). (Check_Aspect_At_Freeze_Point): Return with no action for a Storage_Model_Type aspect with no expression (fully-defaulted native memory-model case). (Resolve_Storage_Model_Type_Argument): If an Address_Type has not been explicitly specified, then set Addr_Type to denote type System.Address. (Validate_Storage_Model_Type_Aspect): Return immediately in the case where the aspect has no Expression (fully-defaulted native memory-model case). No longer issue an error when Address_Type isn't specified, and instead use type System.Address as the default address type. When the address type is System.Address (whether specified or defaulted), no longer issue errors for any other "subaspects" that aren't specified, since in that case those are allowed to default as well. Remove ??? comment about needing to check for duplicates, which is now addressed. (Check_And_Resolve_Storage_Model_Type_Argument): New procedure to check that an association for a storage-model subaspect in the aggregate has not been specified earlier in the aggregate, and to then resolve the expression of the association and save the resolved entity. Called by Validate_Storage_Model_Type_Aspect. * sem_util.ads (Storage_Model_Support): Update comments on specs of the functions Get_Storage_Model_Type_Entity, Storage_Model_Address_Type, and Storage_Model_Null_Address to indicate the behavior when the address type is System.Address (the native memory-model case). * sem_util.adb (Storage_Model_Support.Get_Storage_Model_Type_Entity): Suppress the search for the given subaspect name (Nam) when the Storage_Model_Type aspect is fully defaulted (i.e., no Expression is present) and simply return. In cases where the search is done, but no association that matches Nam is found, return System.Address for the Name_Address_Type case, return System.Null_Address for the Name_Null_Address case, and return Empty for all other cases. diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -441,7 +441,7 @@ package Aspects is Aspect_SPARK_Mode => Optional_Name, Aspect_Stable_Properties => Expression, Aspect_Static_Predicate => Expression, - Aspect_Storage_Model_Type => Expression, + Aspect_Storage_Model_Type => Optional_Expression, Aspect_Storage_Pool => Name, Aspect_Storage_Size => Expression, Aspect_Stream_Size => Expression, diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -6406,16 +6406,7 @@ package body Exp_Util is begin if Has_Storage_Model_Type_Aspect (Typ) then - declare - SMT_Op : constant Entity_Id := - Get_Storage_Model_Type_Entity (Typ, Nam); - begin - if not Present (SMT_Op) then - raise Program_Error; - else - return SMT_Op; - end if; - end; + return Get_Storage_Model_Type_Entity (Typ, Nam); -- Otherwise we assume that Typ is a descendant of Root_Storage_Pool diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -623,8 +623,10 @@ package Exp_Util is -- specifies aspect Storage_Model_Type, returns the Entity_Id of the -- subprogram associated with Nam, which must either be a primitive op of -- the type in the case of a storage pool, or the operation corresponding - -- to Nam as specified in the aspect Storage_Model_Type. It is an error if - -- no operation corresponding to the given name is found. + -- to Nam as specified in the aspect Storage_Model_Type. In the case of + -- aspect Storage_Model_Type, returns Empty when no operation is found, + -- indicating that the operation is defaulted in the aspect (can occur in + -- the case where the storage-model address type is System.Address). function Find_Hook_Context (N : Node_Id) return Node_Id; -- Determine a suitable node on which to attach actions related to N that diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -23,59 +23,60 @@ -- -- ------------------------------------------------------------------------------ -with Aspects; use Aspects; -with Atree; use Atree; -with Checks; use Checks; -with Contracts; use Contracts; -with Debug; use Debug; -with Einfo; use Einfo; -with Einfo.Entities; use Einfo.Entities; -with Einfo.Utils; use Einfo.Utils; -with Elists; use Elists; -with Errout; use Errout; -with Exp_Ch3; use Exp_Ch3; -with Exp_Disp; use Exp_Disp; -with Exp_Tss; use Exp_Tss; -with Exp_Util; use Exp_Util; -with Freeze; use Freeze; -with Ghost; use Ghost; -with Lib; use Lib; -with Lib.Xref; use Lib.Xref; -with Namet; use Namet; -with Nlists; use Nlists; -with Nmake; use Nmake; -with Opt; use Opt; -with Par_SCO; use Par_SCO; -with Restrict; use Restrict; -with Rident; use Rident; -with Rtsfind; use Rtsfind; -with Sem; use Sem; -with Sem_Aux; use Sem_Aux; -with Sem_Case; use Sem_Case; -with Sem_Cat; use Sem_Cat; -with Sem_Ch3; use Sem_Ch3; -with Sem_Ch6; use Sem_Ch6; -with Sem_Ch7; use Sem_Ch7; -with Sem_Ch8; use Sem_Ch8; -with Sem_Dim; use Sem_Dim; -with Sem_Eval; use Sem_Eval; -with Sem_Prag; use Sem_Prag; -with Sem_Res; use Sem_Res; -with Sem_Type; use Sem_Type; -with Sem_Util; use Sem_Util; -with Sem_Warn; use Sem_Warn; -with Sinfo; use Sinfo; -with Sinfo.Nodes; use Sinfo.Nodes; -with Sinfo.Utils; use Sinfo.Utils; -with Sinput; use Sinput; -with Snames; use Snames; -with Stand; use Stand; +with Aspects; use Aspects; +with Atree; use Atree; +with Checks; use Checks; +with Contracts; use Contracts; +with Debug; use Debug; +with Einfo; use Einfo; +with Einfo.Entities; use Einfo.Entities; +with Einfo.Utils; use Einfo.Utils; +with Elists; use Elists; +with Errout; use Errout; +with Exp_Ch3; use Exp_Ch3; +with Exp_Disp; use Exp_Disp; +with Exp_Tss; use Exp_Tss; +with Exp_Util; use Exp_Util; +with Freeze; use Freeze; +with Ghost; use Ghost; +with Lib; use Lib; +with Lib.Xref; use Lib.Xref; +with Namet; use Namet; +with Nlists; use Nlists; +with Nmake; use Nmake; +with Opt; use Opt; +with Par_SCO; use Par_SCO; +with Restrict; use Restrict; +with Rident; use Rident; +with Rtsfind; use Rtsfind; +with Sem; use Sem; +with Sem_Aux; use Sem_Aux; +with Sem_Case; use Sem_Case; +with Sem_Cat; use Sem_Cat; +with Sem_Ch3; use Sem_Ch3; +with Sem_Ch6; use Sem_Ch6; +with Sem_Ch7; use Sem_Ch7; +with Sem_Ch8; use Sem_Ch8; +with Sem_Dim; use Sem_Dim; +with Sem_Eval; use Sem_Eval; +with Sem_Prag; use Sem_Prag; +with Sem_Res; use Sem_Res; +with Sem_Type; use Sem_Type; +with Sem_Util; use Sem_Util; +with Sem_Warn; use Sem_Warn; +with Sinfo; use Sinfo; +with Sinfo.Nodes; use Sinfo.Nodes; +with Sinfo.Utils; use Sinfo.Utils; +with Sinput; use Sinput; +with Snames; use Snames; +with Stand; use Stand; +with System.Case_Util; use System.Case_Util; with Table; -with Targparm; use Targparm; -with Ttypes; use Ttypes; -with Tbuild; use Tbuild; -with Urealp; use Urealp; -with Warnsw; use Warnsw; +with Targparm; use Targparm; +with Ttypes; use Ttypes; +with Tbuild; use Tbuild; +with Urealp; use Urealp; +with Warnsw; use Warnsw; with GNAT.Heap_Sort_G; @@ -11356,6 +11357,16 @@ package body Sem_Ch13 is return; when Aspect_Storage_Model_Type => + + -- The aggregate argument of Storage_Model_Type is optional, and + -- when not present the aspect defaults to the native storage + -- model (where the address type is System.Address, and other + -- arguments default to corresponding native storage operations). + + if No (Expression (ASN)) then + return; + end if; + T := Entity (ASN); declare @@ -16559,12 +16570,14 @@ package body Sem_Ch13 is return; + -- If Addr_Type is not present as the first association, then we default + -- it to System.Address. + elsif not Present (Addr_Type) then - Error_Msg_N ("argument association for Address_Type missing; " - & "must be specified as first aspect argument", N); - return; + Addr_Type := RTE (RE_Address); + end if; - elsif Nam = Name_Null_Address then + if Nam = Name_Null_Address then if not Is_Entity_Name (N) or else not Is_Constant_Object (Entity (N)) or else @@ -17335,9 +17348,10 @@ package body Sem_Ch13 is procedure Validate_Storage_Model_Type_Aspect (Typ : Entity_Id; ASN : Node_Id) is - Assoc : Node_Id; - Choice : Entity_Id; - Expr : Node_Id; + Assoc : Node_Id; + Choice : Entity_Id; + Choice_Name : Name_Id; + Expr : Node_Id; Address_Type_Id : Entity_Id := Empty; Null_Address_Id : Entity_Id := Empty; @@ -17347,7 +17361,47 @@ package body Sem_Ch13 is Copy_To_Id : Entity_Id := Empty; Storage_Size_Id : Entity_Id := Empty; + procedure Check_And_Resolve_Storage_Model_Type_Argument + (Expr : Node_Id; + Typ : Entity_Id; + Argument_Id : in out Entity_Id; + Nam : Name_Id); + -- Checks that the subaspect for Nam has not already been specified for + -- Typ's Storage_Model_Type aspect (i.e., checks Argument_Id = Empty), + -- resolves Expr, and sets Argument_Id to the entity resolved for Expr. + + procedure Check_And_Resolve_Storage_Model_Type_Argument + (Expr : Node_Id; + Typ : Entity_Id; + Argument_Id : in out Entity_Id; + Nam : Name_Id) + is + Name_String : constant String := To_Mixed (Get_Name_String (Nam)); + + begin + if Present (Argument_Id) then + Error_Msg_String (1 .. Name_String'Length) := Name_String; + Error_Msg_Strlen := Name_String'Length; + + Error_Msg_N ("~ already specified", Expr); + end if; + + Resolve_Storage_Model_Type_Argument (Expr, Typ, Address_Type_Id, Nam); + Argument_Id := Entity (Expr); + end Check_And_Resolve_Storage_Model_Type_Argument; + + -- Start of processing for Validate_Storage_Model_Type_Aspect + begin + -- The aggregate argument of Storage_Model_Type is optional, and when + -- not present the aspect defaults to the native storage model (where + -- the address type is System.Address, and other arguments default to + -- the corresponding native storage operations). + + if No (Expression (ASN)) then + return; + end if; + -- Each expression must resolve to an entity of the right kind or proper -- profile. @@ -17358,65 +17412,67 @@ package body Sem_Ch13 is Choice := First (Choices (Assoc)); + Choice_Name := Chars (Choice); + if Nkind (Choice) /= N_Identifier or else Present (Next (Choice)) then Error_Msg_N ("illegal name in association", Choice); - elsif Chars (Choice) = Name_Address_Type then + elsif Choice_Name = Name_Address_Type then if Assoc /= First (Component_Associations (Expression (ASN))) then Error_Msg_N ("Address_Type must be first association", Choice); end if; - Resolve_Storage_Model_Type_Argument + Check_And_Resolve_Storage_Model_Type_Argument (Expr, Typ, Address_Type_Id, Name_Address_Type); - Address_Type_Id := Entity (Expr); - -- Shouldn't we check for duplicates of the same subaspect name, - -- and issue an error in such cases??? + else + -- It's allowed to leave out the Address_Type argument, in which + -- case the address type is defined to default to System.Address. - elsif not Present (Address_Type_Id) then - Error_Msg_N - ("Address_Type missing, must be first association", Choice); - - elsif Chars (Choice) = Name_Null_Address then - Resolve_Storage_Model_Type_Argument - (Expr, Typ, Address_Type_Id, Name_Null_Address); - Null_Address_Id := Entity (Expr); - - elsif Chars (Choice) = Name_Allocate then - Resolve_Storage_Model_Type_Argument - (Expr, Typ, Address_Type_Id, Name_Allocate); - Allocate_Id := Entity (Expr); - - elsif Chars (Choice) = Name_Deallocate then - Resolve_Storage_Model_Type_Argument - (Expr, Typ, Address_Type_Id, Name_Deallocate); - Deallocate_Id := Entity (Expr); - - elsif Chars (Choice) = Name_Copy_From then - Resolve_Storage_Model_Type_Argument - (Expr, Typ, Address_Type_Id, Name_Copy_From); - Copy_From_Id := Entity (Expr); - - elsif Chars (Choice) = Name_Copy_To then - Resolve_Storage_Model_Type_Argument - (Expr, Typ, Address_Type_Id, Name_Copy_To); - Copy_To_Id := Entity (Expr); - - elsif Chars (Choice) = Name_Storage_Size then - Resolve_Storage_Model_Type_Argument - (Expr, Typ, Address_Type_Id, Name_Storage_Size); - Storage_Size_Id := Entity (Expr); + if No (Address_Type_Id) then + Address_Type_Id := RTE (RE_Address); + end if; - else - Error_Msg_N - ("invalid name for Storage_Model_Type argument", Choice); + if Choice_Name = Name_Null_Address then + Check_And_Resolve_Storage_Model_Type_Argument + (Expr, Typ, Null_Address_Id, Name_Null_Address); + + elsif Choice_Name = Name_Allocate then + Check_And_Resolve_Storage_Model_Type_Argument + (Expr, Typ, Allocate_Id, Name_Allocate); + + elsif Choice_Name = Name_Deallocate then + Check_And_Resolve_Storage_Model_Type_Argument + (Expr, Typ, Deallocate_Id, Name_Deallocate); + + elsif Choice_Name = Name_Copy_From then + Check_And_Resolve_Storage_Model_Type_Argument + (Expr, Typ, Copy_From_Id, Name_Copy_From); + + elsif Choice_Name = Name_Copy_To then + Check_And_Resolve_Storage_Model_Type_Argument + (Expr, Typ, Copy_To_Id, Name_Copy_To); + + elsif Choice_Name = Name_Storage_Size then + Check_And_Resolve_Storage_Model_Type_Argument + (Expr, Typ, Storage_Size_Id, Name_Storage_Size); + + else + Error_Msg_N + ("invalid name for Storage_Model_Type argument", Choice); + end if; end if; Next (Assoc); end loop; - if No (Address_Type_Id) then - Error_Msg_N ("match for Address_Type not found", ASN); + -- If Address_Type has been specified as or defaults to System.Address, + -- then other "subaspect" arguments can be specified, but are optional. + -- Otherwise, all other arguments are required and an error is flagged + -- about any that are missing. + + if Address_Type_Id = RTE (RE_Address) then + return; elsif No (Null_Address_Id) then Error_Msg_N ("match for Null_Address primitive not found", ASN); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -32575,18 +32575,37 @@ package body Sem_Util is Find_Value_Of_Aspect (Typ, Aspect_Storage_Model_Type); begin - pragma Assert (Present (SMT_Aspect_Value)); + -- When the aspect has an aggregate expression, search through it + -- to locate a match for the name of the given "subaspect" and return + -- the entity of the aggregate association's expression. + + if Present (SMT_Aspect_Value) then + Assoc := First (Component_Associations (SMT_Aspect_Value)); + while Present (Assoc) loop + if Chars (First (Choices (Assoc))) = Nam then + return Entity (Expression (Assoc)); + end if; - Assoc := First (Component_Associations (SMT_Aspect_Value)); - while Present (Assoc) loop - if Chars (First (Choices (Assoc))) = Nam then - return Entity (Expression (Assoc)); - end if; + Next (Assoc); + end loop; + end if; - Next (Assoc); - end loop; + -- The aggregate argument of Storage_Model_Type is optional, and when + -- not present the aspect defaults to the native storage model, where + -- the address type is System.Address. In that case, we return + -- System.Address for Name_Address_Type and System.Null_Address for + -- Name_Null_Address, but return Empty for other cases, and leave it + -- to the back end to map those to the appropriate native operations. - return Empty; + if Nam = Name_Address_Type then + return RTE (RE_Address); + + elsif Nam = Name_Null_Address then + return RTE (RE_Null_Address); + + else + return Empty; + end if; end Get_Storage_Model_Type_Entity; -------------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -3680,21 +3680,26 @@ package Sem_Util is -- Given a type with aspect Storage_Model_Type or an object of such a -- type, and Nam denoting the name of one of the argument kinds allowed -- for that aspect, returns the Entity_Id corresponding to the entity - -- associated with Nam in the aspect. If such an entity is not present, - -- then returns Empty. (Note: This function is modeled on function - -- Get_Iterable_Type_Primitive.) + -- associated with Nam in the aspect. If an entity was not explicitly + -- specified for Nam, then returns Empty, except that in the defaulted + -- Address_Type case, System.Address will be returned, and in the + -- defaulted Null_Address case, System.Null_Address will be returned. + -- (Note: This function is modeled on Get_Iterable_Type_Primitive.) function Storage_Model_Address_Type (SM_Obj_Or_Type : Entity_Id) return Entity_Id; -- Given a type with aspect Storage_Model_Type or an object of such a -- type, returns the type specified for the Address_Type choice in that - -- aspect; returns Empty if the type isn't specified. + -- aspect; returns type System.Address if the address type was not + -- explicitly specified (indicating use of the native memory model). function Storage_Model_Null_Address (SM_Obj_Or_Type : Entity_Id) return Entity_Id; -- Given a type with aspect Storage_Model_Type or an object of such a -- type, returns the constant specified for the Null_Address choice in - -- that aspect; returns Empty if the constant object isn't specified. + -- that aspect; returns Empty if the constant object isn't specified, + -- unless the native memory model is in use (System.Address), in which + -- case it returns System.Null_Address. function Storage_Model_Allocate (SM_Obj_Or_Type : Entity_Id) return Entity_Id;