From patchwork Wed Sep 26 09:23:46 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: 974933 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-486413-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=adacore.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="D1YvDxwM"; 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 42Ksvq0hZPz9s89 for ; Wed, 26 Sep 2018 19:24:22 +1000 (AEST) 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=RX/imR7AyxkY2oNgfRk10vIbgdrdIWLX7H0X+Jw6pIOarxeHT2 5zyTINMpwEvNWnvRlmy5ayyDzvtDmzyKZDFinR2d3qD6d673Yfm0hUpVL0g73sQu ZW6XbL/2Jgf42qx00EllS3iDuZzgouIA63XBegAJeHCTkNhjDwvunjygs= 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=ghT1JFvfs1hkvkuDnah7uSMvZgY=; b=D1YvDxwMrSu2r8UpFwZc EUgCtmXt+PlxB6N/DSDO4w/zIpS7xJRI2GzphyKIpBtTD7RsZAluQYw4Nxti+sA2 mDSF2vRuLqZt5jMJsG5KUJj8lNC6fSY0VuLbfYlG/ACARxUF2Mijx94UmZM4cON7 vMwz34zD+XeUO7KPKyVrLNw= Received: (qmail 30383 invoked by alias); 26 Sep 2018 09:23:51 -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 30176 invoked by uid 89); 26 Sep 2018 09:23:50 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-11.9 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=exp_disp 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; Wed, 26 Sep 2018 09:23:48 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id C708A116125; Wed, 26 Sep 2018 05:23:46 -0400 (EDT) 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 ue1402+n6iOq; Wed, 26 Sep 2018 05:23:46 -0400 (EDT) Received: from tron.gnat.com (tron.gnat.com [205.232.38.10]) by rock.gnat.com (Postfix) with ESMTP id B66E1116118; Wed, 26 Sep 2018 05:23:46 -0400 (EDT) Received: by tron.gnat.com (Postfix, from userid 4862) id B25423499; Wed, 26 Sep 2018 05:23:46 -0400 (EDT) Date: Wed, 26 Sep 2018 05:23:46 -0400 From: Pierre-Marie de Rodat To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [Ada] Preparation for new description of interface thunks Message-ID: <20180926092346.GA125612@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-IsSubscribed: yes This adjusts and exposes a couple of functions of the front-end used for the generation of interface thunks so as to make them callable from gigi. This also propagates the debug info setting from the targets to the thunks so as to make stepping into primitives work better in the debugger. Tested on x86_64-pc-linux-gnu, committed on trunk 2018-09-26 Eric Botcazou gcc/ada/ * exp_disp.adb (Expand_Interface_Conversion): Use Present test. (Expand_Interface_Thunk): Propagate debug info setting from target. * exp_util.ads (Find_Interface_Tag): Adjust comment. * exp_util.adb (Find_Interface_Tag): Remove assertions of success. * sem_util.adb (Is_Variable_Size_Record): Only look at components and robustify the implementation. * fe.h (Find_Interface_Tag): Declare. (Is_Variable_Size_Record): Likewise. --- gcc/ada/exp_disp.adb +++ gcc/ada/exp_disp.adb @@ -1454,7 +1454,7 @@ package body Exp_Disp is end if; Iface_Tag := Find_Interface_Tag (Operand_Typ, Iface_Typ); - pragma Assert (Iface_Tag /= Empty); + pragma Assert (Present (Iface_Tag)); -- Keep separate access types to interfaces because one internal -- function is used to handle the null value (see following comments) @@ -2046,6 +2046,7 @@ package body Exp_Disp is Set_Ekind (Thunk_Id, Ekind (Prim)); Set_Is_Thunk (Thunk_Id); Set_Convention (Thunk_Id, Convention (Prim)); + Set_Needs_Debug_Info (Thunk_Id, Needs_Debug_Info (Target)); Set_Thunk_Entity (Thunk_Id, Target); -- Procedure case --- gcc/ada/exp_util.adb +++ gcc/ada/exp_util.adb @@ -5529,7 +5529,6 @@ package body Exp_Util is then -- Skip the tag associated with the primary table - pragma Assert (Etype (First_Tag_Component (Typ)) = RTE (RE_Tag)); AI_Tag := Next_Tag_Component (First_Tag_Component (Typ)); pragma Assert (Present (AI_Tag)); @@ -5590,14 +5589,12 @@ package body Exp_Util is -- primary dispatch table. if Is_Ancestor (Iface, Typ, Use_Full_View => True) then - pragma Assert (Etype (First_Tag_Component (Typ)) = RTE (RE_Tag)); return First_Tag_Component (Typ); -- Otherwise we need to search for its associated tag component else Find_Tag (Typ); - pragma Assert (Found); return AI_Tag; end if; end Find_Interface_Tag; --- gcc/ada/exp_util.ads +++ gcc/ada/exp_util.ads @@ -585,8 +585,9 @@ package Exp_Util is function Find_Interface_Tag (T : Entity_Id; Iface : Entity_Id) return Entity_Id; - -- Ada 2005 (AI-251): Given a type T implementing the interface Iface, - -- return the record component containing the tag of Iface. + -- Ada 2005 (AI-251): Given a type T and an interface Iface, return the + -- record component containing the tag of Iface if T implements Iface or + -- Empty if it does not. function Find_Prim_Op (T : Entity_Id; Name : Name_Id) return Entity_Id; -- Find the first primitive operation of a tagged type T with name Name. --- gcc/ada/fe.h +++ gcc/ada/fe.h @@ -159,8 +159,10 @@ extern void Get_External_Name (Entity_Id, Boolean, String_Pointer); /* exp_util: */ #define Is_Fully_Repped_Tagged_Type exp_util__is_fully_repped_tagged_type +#define Find_Interface_Tag exp_util__find_interface_tag extern Boolean Is_Fully_Repped_Tagged_Type (Entity_Id); +extern Entity_Id Find_Interface_Tag (Entity_Id, Entity_Id); /* lib: */ @@ -269,12 +271,14 @@ extern Boolean Is_OK_Static_Subtype (Entity_Id); #define Defining_Entity sem_util__defining_entity #define First_Actual sem_util__first_actual #define Next_Actual sem_util__next_actual +#define Is_Variable_Size_Record sem_util__is_variable_size_record #define Requires_Transient_Scope sem_util__requires_transient_scope extern Entity_Id Defining_Entity (Node_Id); extern Node_Id First_Actual (Node_Id); extern Node_Id Next_Actual (Node_Id); -extern Boolean Requires_Transient_Scope (Entity_Id); +extern Boolean Is_Variable_Size_Record (Entity_Id Id); +extern Boolean Requires_Transient_Scope (Entity_Id); /* sinfo: */ --- gcc/ada/sem_util.adb +++ gcc/ada/sem_util.adb @@ -17714,9 +17714,9 @@ package body Sem_Util is begin pragma Assert (Is_Record_Type (E)); - Comp := First_Entity (E); + Comp := First_Component (E); while Present (Comp) loop - Comp_Typ := Etype (Comp); + Comp_Typ := Underlying_Type (Etype (Comp)); -- Recursive call if the record type has discriminants @@ -17732,7 +17732,7 @@ package body Sem_Util is return True; end if; - Next_Entity (Comp); + Next_Component (Comp); end loop; return False;