From patchwork Thu Aug 1 15:17:18 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: =?utf-8?q?Marc_Poulhi=C3=A8s?= X-Patchwork-Id: 1967856 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (2048-bit key; secure) header.d=adacore.com header.i=@adacore.com header.a=rsa-sha256 header.s=google header.b=Pd0QVqbJ; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4WZY6S2c4sz1ybX for ; Fri, 2 Aug 2024 01:39:12 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 95CB0384B813 for ; Thu, 1 Aug 2024 15:39:10 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-wm1-x329.google.com (mail-wm1-x329.google.com [IPv6:2a00:1450:4864:20::329]) by sourceware.org (Postfix) with ESMTPS id 16D78385ED72 for ; Thu, 1 Aug 2024 15:18:01 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 16D78385ED72 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 16D78385ED72 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=2a00:1450:4864:20::329 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1722525495; cv=none; b=Gp5xWDcxpTji1bsxGlNDxGzJqLEeNKtAjKgcfo7dRAIAEvS42uzg6qdkARpmlDS8GcTEocGmtsivtBaue5gw7w7OBlE52XZT48FNfPHfI07EYQg8LxxYABB2c895pbvChnb0vjBriUN1GearwcorKYOQ1NOhzVt7DHkAeu/MMOc= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1722525495; c=relaxed/simple; bh=uJ92PGY2KuRnPlKxt3zBfTAkHwAqJ6YRA+O5z67MYao=; h=DKIM-Signature:From:To:Subject:Date:Message-ID:MIME-Version; b=A585NGUDq4DjKXwyW9SjBZUWssZgUgj8CzkZz0+zAh8SM04WkLOn7kxqt3I25L6TKQuYKeeah5D6QKQpmj+C/kv8yLE5a7TWvbBolOpIzaAhtpydSBpLRN4tKPjARFlYToUKL6WAgL9MscxefGbYULhW0t00JZTPNNFpWXG8Fys= ARC-Authentication-Results: i=1; server2.sourceware.org Received: by mail-wm1-x329.google.com with SMTP id 5b1f17b1804b1-42819654737so41509485e9.1 for ; Thu, 01 Aug 2024 08:18:01 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1722525480; x=1723130280; darn=gcc.gnu.org; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:from:to:cc:subject:date :message-id:reply-to; bh=ZdayRQIZrGTWkmsU7aNeI9PBgEQkjjosblTdhxN3cvw=; b=Pd0QVqbJSSwNkMSIwK8f4Ddx939x3t7TL/jf+B8luKhyiqBMQ1XjK8ZiifUwzXxq/H ZtnthG3mBc3O8AmoJjp62xkLZYS5cxsJ4dKNA675hqD3cPtqzJm8GJZ4GmYZ3FQpXHEW 6VJHsuytnuFoXyQoRJUby8lWoGWlRDfaW2+0MUoU7mQ3dwe9z6RM4VH5rnw3ToDnfhPz syADxMBN2hhmwl+jdgTlLFTXwQEN7cwdvINHzErAWK6T542ao3qixufTNFsmhEZkMjEN xTbHGhICl67vCNslv5YBROsZSKaFf2DVVb9JZDvz/8mWqt1m6wH91uEZLTndaVHRUWmf kKIg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1722525480; x=1723130280; h=content-transfer-encoding:mime-version:references:in-reply-to :message-id:date:subject:cc:to:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=ZdayRQIZrGTWkmsU7aNeI9PBgEQkjjosblTdhxN3cvw=; b=Cj8S0exFUfZYQuuKbFLDuKcDGJRPEh6wtuwSMbitJsdoP7nwdTcTleRaHmrGJWAKMv vRm3ao4WGwigNkVto3lu6nM5wLfBzvVspZ144dXa8DSr19/QddIAW8SpGsiug91QwkQ/ KT23rB8QeW9qnYkpbl1rXkAKwTTBDOEB6M8avqT5vntrGkeh00F/wsbxVYRv/fSY3Ddj nJGwLPafQJOiTwUcDUJmZsVxvf0KL5DQhGkI2QG3AsUyUV7taQgpm7SqCDqvjjXSDKe3 eETTV+k7SGl1wiLfGXEY5P3gMjU4bihT8Ygfki2vJsm3Ux4mpQfG9yl92SIWPbTKEhAB V3DQ== X-Gm-Message-State: AOJu0YwX5Ro+EuZfLa8OVLXzA5yDso5/jdPi1K+6OD10N/wkasEMknxy r7JTUjvH512Nwlgxv2dLBJZlgUIk7+asEE8sQSxhHL6q11UG0TwISDJAsTeWkeya6CavEHIJsgM iiA== X-Google-Smtp-Source: AGHT+IFr1vyFjvEsZKPR3z4DvNlGlwn8L+046oBXhEngSzKcQcksaY6Q+J4bS06RLNDkm3+kAtD2GQ== X-Received: by 2002:a5d:6903:0:b0:368:6660:36df with SMTP id ffacd0b85a97d-36bbc0fcc21mr120010f8f.35.1722525479502; Thu, 01 Aug 2024 08:17:59 -0700 (PDT) Received: from localhost.localdomain ([2001:861:3382:1a90:b6aa:4751:9ea1:da1e]) by smtp.gmail.com with ESMTPSA id ffacd0b85a97d-36b36857fdesm20065995f8f.75.2024.08.01.08.17.57 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 01 Aug 2024 08:17:59 -0700 (PDT) From: =?utf-8?q?Marc_Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Arnaud Charlet Subject: [COMMITTED 10/30] ada: Followup on previous change for -gnatceg Date: Thu, 1 Aug 2024 17:17:18 +0200 Message-ID: <20240801151738.400796-10-poulhies@adacore.com> X-Mailer: git-send-email 2.45.2 In-Reply-To: <20240801151738.400796-1-poulhies@adacore.com> References: <20240801151738.400796-1-poulhies@adacore.com> MIME-Version: 1.0 X-Spam-Status: No, score=-13.2 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 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.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org From: Arnaud Charlet gcc/ada/ * osint-c.ads, osint-c.adb (Create_C_File, Close_C_File, Delete_C_File): Put back, needed by LLVM based CCG. * exp_unst.adb (Unnest_Subprogram): Complete previous change by removing now dead code and corresponding ??? comment. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/exp_unst.adb | 195 +------------------------------------------ gcc/ada/osint-c.adb | 40 +++++++++ gcc/ada/osint-c.ads | 18 ++-- 3 files changed, 55 insertions(+), 198 deletions(-) diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index 19bb8948a89..7ff1ea621bb 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -2190,197 +2190,10 @@ package body Exp_Unst is end loop; end Subp_Loop; - -- Next step, process uplevel references. This has to be done in a - -- separate pass, after completing the processing in Sub_Loop because we - -- need all the AREC declarations generated, inserted, and analyzed so - -- that the uplevel references can be successfully analyzed. - - Uplev_Refs : for J in Urefs.First .. Urefs.Last loop - declare - UPJ : Uref_Entry renames Urefs.Table (J); - - begin - -- Ignore type references, these are implicit references that do - -- not need rewriting (e.g. the appearance in a conversion). - -- Also ignore if no reference was specified or if the rewriting - -- has already been done (this can happen if the N_Identifier - -- occurs more than one time in the tree). Also ignore references - -- with GNAT-LLVM (CCG_Mode), since it will handle the processing - -- for up-level refs). - -- ??? At this stage, only GNAT LLVM uses front-end unnesting, so - -- consider remove the code below. - - if No (UPJ.Ref) - or else not Is_Entity_Name (UPJ.Ref) - or else No (Entity (UPJ.Ref)) - or else Opt.CCG_Mode - then - goto Continue; - end if; - - -- Rewrite one reference - - Rewrite_One_Ref : declare - Loc : constant Source_Ptr := Sloc (UPJ.Ref); - -- Source location for the reference - - Typ : constant Entity_Id := Etype (UPJ.Ent); - -- The type of the referenced entity - - Atyp : Entity_Id; - -- The actual subtype of the reference - - RS_Caller : constant SI_Type := Subp_Index (UPJ.Caller); - -- Subp_Index for caller containing reference - - STJR : Subp_Entry renames Subps.Table (RS_Caller); - -- Subp_Entry for subprogram containing reference - - RS_Callee : constant SI_Type := Subp_Index (UPJ.Callee); - -- Subp_Index for subprogram containing referenced entity - - STJE : Subp_Entry renames Subps.Table (RS_Callee); - -- Subp_Entry for subprogram containing referenced entity - - Pfx : Node_Id; - Comp : Entity_Id; - SI : SI_Type; - - begin - Atyp := Etype (UPJ.Ref); - - if Ekind (Atyp) /= E_Record_Subtype then - Atyp := Get_Actual_Subtype (UPJ.Ref); - end if; - - -- Ignore if no ARECnF entity for enclosing subprogram which - -- probably happens as a result of not properly treating - -- instance bodies. To be examined ??? - - -- If this test is omitted, then the compilation of freeze.adb - -- and inline.adb fail in unnesting mode. - - if No (STJR.ARECnF) then - goto Continue; - end if; - - -- If this is a reference to a global constant, use its value - -- rather than create a reference. It is more efficient and - -- furthermore indispensable if the context requires a - -- constant, such as a branch of a case statement. - - if Ekind (UPJ.Ent) = E_Constant - and then Is_True_Constant (UPJ.Ent) - and then Present (Constant_Value (UPJ.Ent)) - and then Is_Static_Expression (Constant_Value (UPJ.Ent)) - then - Rewrite (UPJ.Ref, New_Copy_Tree (Constant_Value (UPJ.Ent))); - goto Continue; - end if; - - -- Push the current scope, so that the pointer type Tnn, and - -- any subsidiary entities resulting from the analysis of the - -- rewritten reference, go in the right entity chain. - - Push_Scope (STJR.Ent); - - -- Now we need to rewrite the reference. We have a reference - -- from level STJR.Lev to level STJE.Lev. The general form of - -- the rewritten reference for entity X is: - - -- Typ'Deref (ARECaF.ARECbU.ARECcU.ARECdU....ARECmU.X) - - -- where a,b,c,d .. m = - -- STJR.Lev - 1, STJR.Lev - 2, .. STJE.Lev - - pragma Assert (STJR.Lev > STJE.Lev); - - -- Compute the prefix of X. Here are examples to make things - -- clear (with parens to show groupings, the prefix is - -- everything except the .X at the end). - - -- level 2 to level 1 - - -- AREC1F.X - - -- level 3 to level 1 - - -- (AREC2F.AREC1U).X - - -- level 4 to level 1 - - -- ((AREC3F.AREC2U).AREC1U).X - - -- level 6 to level 2 - - -- (((AREC5F.AREC4U).AREC3U).AREC2U).X - - -- In the above, ARECnF and ARECnU are pointers, so there are - -- explicit dereferences required for these occurrences. - - Pfx := - Make_Explicit_Dereference (Loc, - Prefix => New_Occurrence_Of (STJR.ARECnF, Loc)); - SI := RS_Caller; - for L in STJE.Lev .. STJR.Lev - 2 loop - SI := Enclosing_Subp (SI); - Pfx := - Make_Explicit_Dereference (Loc, - Prefix => - Make_Selected_Component (Loc, - Prefix => Pfx, - Selector_Name => - New_Occurrence_Of (Subps.Table (SI).ARECnU, Loc))); - end loop; - - -- Get activation record component (must exist) - - Comp := Activation_Record_Component (UPJ.Ent); - pragma Assert (Present (Comp)); - - -- Do the replacement. If the component type is an access type, - -- this is an uplevel reference for an entity that requires a - -- fat pointer, so dereference the component. - - if Is_Access_Type (Etype (Comp)) then - Rewrite (UPJ.Ref, - Make_Explicit_Dereference (Loc, - Prefix => - Make_Selected_Component (Loc, - Prefix => Pfx, - Selector_Name => - New_Occurrence_Of (Comp, Loc)))); - - else - Rewrite (UPJ.Ref, - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Atyp, Loc), - Attribute_Name => Name_Deref, - Expressions => New_List ( - Make_Selected_Component (Loc, - Prefix => Pfx, - Selector_Name => - New_Occurrence_Of (Comp, Loc))))); - end if; - - -- Analyze and resolve the new expression. We do not need to - -- establish the relevant scope stack entries here, because we - -- have already set all the correct entity references, so no - -- name resolution is needed. We have already set the current - -- scope, so that any new entities created will be in the right - -- scope. - - -- We analyze with all checks suppressed (since we do not - -- expect any exceptions) - - Analyze_And_Resolve (UPJ.Ref, Typ, Suppress => All_Checks); - Pop_Scope; - end Rewrite_One_Ref; - end; - - <> - null; - end loop Uplev_Refs; + -- Note: we used to process uplevel references, in particular for the + -- old CCG (cprint.adb). With GNAT LLVM, processing of uplevel + -- references needs to be done directly there which is more reliable, so + -- we no longer need to do it here. -- Finally, loop through all calls adding extra actual for the -- activation record where it is required. diff --git a/gcc/ada/osint-c.adb b/gcc/ada/osint-c.adb index 0fef274217a..08abbae9464 100644 --- a/gcc/ada/osint-c.adb +++ b/gcc/ada/osint-c.adb @@ -44,6 +44,23 @@ package body Osint.C is -- output file and Suffix is the desired suffix (dg/rep/xxx for debug/ -- repinfo/list file where xxx is specified extension. + ------------------ + -- Close_C_File -- + ------------------ + + procedure Close_C_File is + Status : Boolean; + + begin + Close (Output_FD, Status); + + if not Status then + Fail + ("error while closing file " + & Get_Name_String (Output_File_Name)); + end if; + end Close_C_File; + ---------------------- -- Close_Debug_File -- ---------------------- @@ -173,6 +190,18 @@ package body Osint.C is return Result; end Create_Auxiliary_File; + ------------------- + -- Create_C_File -- + ------------------- + + procedure Create_C_File is + Dummy : Boolean; + begin + Set_File_Name ("c"); + Delete_File (Name_Buffer (1 .. Name_Len), Dummy); + Create_File_And_Check (Output_FD, Text); + end Create_C_File; + ----------------------- -- Create_Debug_File -- ----------------------- @@ -265,6 +294,17 @@ package body Osint.C is end if; end Debug_File_Eol_Length; + ------------------- + -- Delete_C_File -- + ------------------- + + procedure Delete_C_File is + Dummy : Boolean; + begin + Set_File_Name ("c"); + Delete_File (Name_Buffer (1 .. Name_Len), Dummy); + end Delete_C_File; + ------------------- -- Delete_H_File -- ------------------- diff --git a/gcc/ada/osint-c.ads b/gcc/ada/osint-c.ads index bde37c72723..583d9e4b433 100644 --- a/gcc/ada/osint-c.ads +++ b/gcc/ada/osint-c.ads @@ -160,22 +160,26 @@ package Osint.C is -------------------------- -- These routines are used by the compiler when the C translation option - -- is activated to write *.h files to the current object directory. - -- Note that the files are written via the Output package routines, using - -- Output_FD. + -- is activated to write *.c or *.h files to the current object directory. + -- Each routine exists in a C and an H form for the two kinds of files. + -- Only one of these files can be written at a time. Note that the files + -- are written via the Output package routines, using Output_FD. + procedure Create_C_File; procedure Create_H_File; - -- Creates the *.h file for the source file which is currently being + -- Creates the *.c/*.h file for the source file which is currently being -- compiled (i.e. the file which was most recently returned by -- Next_Main_Source). + procedure Close_C_File; procedure Close_H_File; - -- Closes the file created by Create_H file, flushing any buffers, etc. + -- Closes the file created by Create_C/H file, flushing any buffers, etc. -- from writes by Write_C_File and Write_H_File; + procedure Delete_C_File; procedure Delete_H_File; - -- Deletes the .h file corresponding to the source file which is currently - -- being compiled. + -- Deletes the .c/.h file corresponding to the source file which is + -- currently being compiled. ---------------------- -- List File Output --