From 76f9c7f44fffb0b03266730b137313fe79f1c99e Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Wed, 3 Feb 2021 05:31:16 -0500 Subject: [Ada] Variable-sized node types gcc/ada/ * atree.ads, atree.adb: Major rewrite to support variable-sized node types. Add pragmas Suppress and Assertion_Policy. We now have an extra level of indirection: Node_Offsets is a table mapping Node_Ids to the offset of the start of each node in Slots. Slots is a table containing one or more contiguous slots for each node. Each slot is a 32-bit unchecked union that can contain any mixture of 1, 2, 4, 8, and 32-bit fields that fits. The old low-level getters and setters (e.g. Flag123) are removed. * gen_il-fields.ads, gen_il-gen-gen_entities.adb, gen_il-gen-gen_nodes.adb, gen_il-gen.adb, gen_il-gen.ads, gen_il-main.adb, gen_il-types.ads, gen_il-utils.adb, gen_il-utils.ads, gen_il.adb, gen_il.ads: New gen_il program that generates various Ada and C++ files. In particular, the following files are generated by gen_il: einfo-entities.adb einfo-entities.ads, gnatvsn.ads, nmake.adb, nmake.ads, seinfo.ads, seinfo_tables.adb, seinfo_tables.ads, sinfo-nodes.adb, sinfo-nodes.ads, einfo.h, and sinfo.h. * sinfo-utils.adb, sinfo-utils.ads, einfo-utils.adb, einfo-utils.ads: New files containing code that needs to refer to Sinfo.Nodes and Einfo.Entities. This code is mostly moved here from Sinfo and Einfo to break cycles. * back_end.adb: Pass node_offsets_ptr and slots_ptr to gigi, instead of nodes_ptr and flags_ptr. The Nodes and Flags tables no longer exist. (Note that gigi never used the Flags table.) * sinfo-cn.ads (Change_Identifier_To_Defining_Identifier, Change_Character_Literal_To_Defining_Character_Literal, Change_Operator_Symbol_To_Defining_Operator_Symbol): Turn N into an IN formal. * sinfo-cn.adb: Update. Add assertions, which can be removed at some point. Rewrite to use higher-level facilities. Make sure vanishing fields are zeroed out. Add with/use for new packages. * sem_util.adb: Remove "Assert(False)" immediately followed by "raise Program_Error". Use higher-level facilities such as Walk_Sinfo_Fields instead of depending on low-level Set_FieldN routines that no longer exist. Use Get_Comes_From_Source_Default instead of Default_Node.Comes_From_Source (Default_Node no longer exists). Use Set_Basic_Convention instead of Basic_Set_Convention. Add with/use for new packages. * sem_util.ads: The Convention field had getter Convention and setter Basic_Set_Convention. Make that more uniform: there is now a field called Basic_Convention, with Basic_Convention and Set_Basic_Convention as getter/setter, and write Convention and Set_Convention here. * nlists.adb: Rewrite to use abstractions, rather then depending on low-level implementation details of Atree. Necessary because those details have changed. Add with/use for new packages. * sem_ch12.adb: Use higher-level facilities such as Walk_Sinfo_Fields instead of depending on low-level Set_FieldN routines that no longer exist. Add with/use for new packages. * exp_cg.adb, sem_ch10.adb, sem_ch4.adb, sem_eval.adb, sem_prag.adb, sem_warn.adb: Change expanded names to refer to the new packages for things that moved. Add with/use for new packages. * sem_ch3.adb: Likewise. Reinitialize vanishing fields. * exp_disp.adb: Likewise. Remove failing assertion. * sinfo.ads, einfo.ads: Remove code that is now generated into Sinfo.Nodes and Einfo.Entities. * sinfo.adb, einfo.adb: Replace bodies with "pragma No_Body;". We should delete these at some point, but No_Body makes make files easier. Some code is moved to Sinfo.Nodes, Einfo.Entities, Sinfo.Utils, and Einfo.Utils. Some is no longer necessary. * treepr.adb: Rewrite to use new tables. We no longer need treeprs.ads. * treepr.ads: Add comment. * types.ads: Move types Component_Alignment_Kind and Float_Rep_Kind here. * atree.h: Major update to match atree.ads changes. Add slot types, for use by getters/setters. * types.h: Move types Component_Alignment_Kind and Float_Rep_Kind here. * fe.h: Rewrite to deal with code that has changed or moved from Atree, Sinfo, Einfo. * nlists.h: Move some code to fe.h. * alloc.ads: Split Nodes_* constants into Node_Offsets and Slots, because Atree has two separate tables. Increase values. Remove Nodes_Release_Threshold. Improve comment. * debug.adb, gnat1drv.adb: Remove obsolete gnatd.A and gnatd.N switches. Add with/use for new packages. * opt.ads: Minor comment fix. * aspects.adb, checks.adb, comperr.adb, contracts.adb, cstand.adb, debug_a.adb, errout.adb, eval_fat.adb, exp_aggr.adb, exp_atag.adb, exp_attr.adb, exp_ch11.adb, exp_ch12.adb, exp_ch13.adb, exp_ch2.adb, exp_ch3.adb, exp_ch4.adb, exp_ch5.adb, exp_ch6.adb, exp_ch7.adb, exp_ch8.adb, exp_ch9.adb, exp_code.adb, exp_dbug.adb, exp_dist.adb, exp_fixd.adb, exp_imgv.adb, exp_intr.adb, exp_pakd.adb, exp_prag.adb, exp_put_image.adb, exp_sel.adb, exp_smem.adb, exp_spark.adb, exp_strm.adb, exp_tss.adb, exp_unst.adb, exp_util.adb, exp_util.ads, expander.adb, freeze.adb, frontend.adb, get_targ.ads, ghost.adb, gnat_cuda.adb, impunit.adb, inline.adb, itypes.adb, itypes.ads, layout.adb, lib.adb, lib-load.adb, lib-writ.adb, lib-xref.adb, lib-xref.ads, lib-xref-spark_specific.adb, live.adb, par.adb, par_sco.adb, pprint.adb, repinfo.adb, restrict.adb, rtsfind.adb, scil_ll.adb, scn.adb, sem.adb, sem.ads, sem_aggr.adb, sem_attr.adb, sem_aux.adb, sem_case.adb, sem_cat.adb, sem_ch11.adb, sem_ch13.adb, sem_ch2.adb, sem_ch5.adb, sem_ch6.adb, sem_ch7.adb, sem_ch8.adb, sem_ch9.adb, sem_dim.adb, sem_disp.adb, sem_dist.adb, sem_elab.adb, sem_elim.adb, sem_intr.adb, sem_mech.adb, sem_res.adb, sem_scil.adb, sem_smem.adb, sem_type.adb, set_targ.ads, sinput.adb, sinput-l.adb, sprint.adb, style.adb, styleg.adb, tbuild.adb, tbuild.ads, uname.adb: Add with/use for new packages. * libgnat/a-stoubu.adb, libgnat/a-stouut.adb: Simplify to ease bootstrap. * libgnat/a-stobfi.adb, libgnat/a-stoufi.adb (Create_File, Create_New_File): Create file in binary format, to avoid introducing unwanted text conversions on Windows. Simplify to ease bootstrap. * libgnat/a-stteou__bootstrap.ads: New. * ceinfo.adb, csinfo.adb, nmake.adt, treeprs.adt, xeinfo.adb, xnmake.adb, xsinfo.adb, xtreeprs.adb: Delete. * Make-generated.in: Build and run the gen_il program to generate files. The files are generated in the ada/gen_il subdirectory, and then moved up to ada. We rely on gnatmake (as opposed to make) to build the gen_il program efficiently (i.e. don't do anything if the sources didn't change). * gcc-interface/Makefile.in (ADAFLAGS): Add -gnatU. (GNATMAKE_OBJS): Add new object files. (GENERATED_FILES_FOR_TOOLS): New variable. (../stamp-tools): Create a link for all GENERATED_FILES_FOR_TOOLS. * gcc-interface/Make-lang.in (GNAT_ADA_OBJS): Add new object files. Remove ada/treeprs.o. (GNATBIND_OBJS): Add new object files. (ada.mostlyclean): Remove ada/sdefault.adb and add ada/stamp-gen_il. (ada.maintainer-clean): Remove ada/treeprs.ads. (update-sources): Remove obsolete target. (ada_generated_files): Rename to... (ADA_GENERATED_FILES): ... this. Add new source files. Add comment. * gcc-interface/trans.c: Remove obsolete Nodes_Ptr and Flags_ptr. Add Node_Offsets_Ptr and Slots_Ptr, which point to the corresponding tables in Atree. * gcc-interface/gigi.h (gigi): New parameters for initializing Node_Offsets_Ptr and Slots_Ptr. * gcc-interface/decl.c: Numeric_Kind, Discrete_Or_Fixed_Point_Kind, and Record_Kind were nonhierarchical, and were therefore removed for simplicity. Replace uses with calls to Is_In_... functions. gnattools/ * Makefile.in (GENERATED_FILES_FOR_TOOLS): New variable. ($(GCC_DIR)/stamp-tools): Walk it for the first copy operation. --- gcc/ada/xnmake.adb | 467 ----------------------------------------------------- 1 file changed, 467 deletions(-) delete mode 100644 gcc/ada/xnmake.adb (limited to 'gcc/ada/xnmake.adb') diff --git a/gcc/ada/xnmake.adb b/gcc/ada/xnmake.adb deleted file mode 100644 index 952e3f7..0000000 --- a/gcc/ada/xnmake.adb +++ /dev/null @@ -1,467 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT SYSTEM UTILITIES -- --- -- --- X N M A K E -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2021, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- --- for more details. You should have received a copy of the GNU General -- --- Public License distributed with GNAT; see file COPYING3. If not, go to -- --- http://www.gnu.org/licenses for a complete copy of the license. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- Program to construct the spec and body of the Nmake package - --- Input files: - --- sinfo.ads Spec of Sinfo package --- nmake.adt Template for Nmake package - --- Output files: - --- nmake.ads Spec of Nmake package --- nmake.adb Body of Nmake package - --- Note: this program assumes that sinfo.ads has passed the error checks that --- are carried out by the csinfo utility, so it does not duplicate these --- checks and assumes that sinfo.ads has the correct form. - --- In the absence of any switches, both the ads and adb files are output. --- The switch -s or /s indicates that only the ads file is to be output. --- The switch -b or /b indicates that only the adb file is to be output. - --- If a file name argument is given, then the output is written to this file --- rather than to nmake.ads or nmake.adb. A file name can only be given if --- exactly one of the -s or -b options is present. - -with Ada.Command_Line; use Ada.Command_Line; -with Ada.Strings.Unbounded; use Ada.Strings.Unbounded; -with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO; -with Ada.Strings.Maps; use Ada.Strings.Maps; -with Ada.Strings.Maps.Constants; use Ada.Strings.Maps.Constants; -with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; -with Ada.Text_IO; use Ada.Text_IO; - -with GNAT.Spitbol; use GNAT.Spitbol; -with GNAT.Spitbol.Patterns; use GNAT.Spitbol.Patterns; - -with XUtil; - -procedure XNmake is - - Err : exception; - -- Raised to terminate execution - - A : VString := Nul; - Arg : VString := Nul; - Arg_List : VString := Nul; - Comment : VString := Nul; - Default : VString := Nul; - Field : VString := Nul; - Line : VString := Nul; - Node : VString := Nul; - Op_Name : VString := Nul; - Prevl : VString := Nul; - Synonym : VString := Nul; - X : VString := Nul; - - NWidth : Natural; - - FileS : VString := V ("nmake.ads"); - FileB : VString := V ("nmake.adb"); - -- Set to null if corresponding file not to be generated - - Given_File : VString := Nul; - -- File name given by command line argument - - subtype Sfile is Ada.Streams.Stream_IO.File_Type; - - InS, InT : Ada.Text_IO.File_Type; - OutS, OutB : Sfile; - - wsp : constant Pattern := Span (' ' & ASCII.HT); - - Body_Only : constant Pattern := BreakX (' ') * X - & Span (' ') & "-- body only"; - Spec_Only : constant Pattern := BreakX (' ') * X - & Span (' ') & "-- spec only"; - - Node_Hdr : constant Pattern := wsp & "-- N_" & Rest * Node; - Punc : constant Pattern := BreakX (" .,"); - - Binop : constant Pattern := wsp - & "-- plus fields for binary operator"; - Unop : constant Pattern := wsp - & "-- plus fields for unary operator"; - Syn : constant Pattern := wsp & "-- " & Break (' ') * Synonym - & " (" & Break (')') * Field - & Rest * Comment; - - Templ : constant Pattern := BreakX ('T') * A & "T e m p l a t e"; - Spec : constant Pattern := BreakX ('S') * A & "S p e c"; - - Sem_Field : constant Pattern := BreakX ('-') & "-Sem"; - Lib_Field : constant Pattern := BreakX ('-') & "-Lib"; - - Get_Field : constant Pattern := BreakX (Decimal_Digit_Set) * Field; - - Get_Dflt : constant Pattern := BreakX ('(') & "(set to " - & Break (" ") * Default & " if"; - - Next_Arg : constant Pattern := Break (',') * Arg & ','; - - Op_Node : constant Pattern := "Op_" & Rest * Op_Name; - - Shft_Rot : constant Pattern := "Shift_" or "Rotate_"; - - No_Ent : constant Pattern := "Or_Else" or "And_Then" - or "In" or "Not_In"; - - M : Match_Result; - - V_String_Id : constant VString := V ("String_Id"); - V_Node_Id : constant VString := V ("Node_Id"); - V_Name_Id : constant VString := V ("Name_Id"); - V_List_Id : constant VString := V ("List_Id"); - V_Elist_Id : constant VString := V ("Elist_Id"); - V_Boolean : constant VString := V ("Boolean"); - - procedure Put_Line (F : Sfile; S : String) renames XUtil.Put_Line; - procedure Put_Line (F : Sfile; S : VString) renames XUtil.Put_Line; - -- Local version of Put_Line ensures Unix style line endings - - procedure WriteS (S : String); - procedure WriteB (S : String); - procedure WriteBS (S : String); - procedure WriteS (S : VString); - procedure WriteB (S : VString); - procedure WriteBS (S : VString); - -- Write given line to spec or body file or both if active - - procedure WriteB (S : String) is - begin - if FileB /= Nul then - Put_Line (OutB, S); - end if; - end WriteB; - - procedure WriteB (S : VString) is - begin - if FileB /= Nul then - Put_Line (OutB, S); - end if; - end WriteB; - - procedure WriteBS (S : String) is - begin - if FileB /= Nul then - Put_Line (OutB, S); - end if; - - if FileS /= Nul then - Put_Line (OutS, S); - end if; - end WriteBS; - - procedure WriteBS (S : VString) is - begin - if FileB /= Nul then - Put_Line (OutB, S); - end if; - - if FileS /= Nul then - Put_Line (OutS, S); - end if; - end WriteBS; - - procedure WriteS (S : String) is - begin - if FileS /= Nul then - Put_Line (OutS, S); - end if; - end WriteS; - - procedure WriteS (S : VString) is - begin - if FileS /= Nul then - Put_Line (OutS, S); - end if; - end WriteS; - --- Start of processing for XNmake - -begin - NWidth := 28; - Anchored_Mode := True; - - for ArgN in 1 .. Argument_Count loop - declare - Arg : constant String := Argument (ArgN); - - begin - if Arg (1) = '-' then - if Arg'Length = 2 - and then (Arg (2) = 'b' or else Arg (2) = 'B') - then - FileS := Nul; - - elsif Arg'Length = 2 - and then (Arg (2) = 's' or else Arg (2) = 'S') - then - FileB := Nul; - - else - raise Err; - end if; - - else - if Given_File /= Nul then - raise Err; - else - Given_File := V (Arg); - end if; - end if; - end; - end loop; - - if FileS = Nul and then FileB = Nul then - raise Err; - - elsif Given_File /= Nul then - if FileB = Nul then - FileS := Given_File; - - elsif FileS = Nul then - FileB := Given_File; - - else - raise Err; - end if; - end if; - - Open (InS, In_File, "sinfo.ads"); - Open (InT, In_File, "nmake.adt"); - - if FileS /= Nul then - Create (OutS, Out_File, S (FileS)); - end if; - - if FileB /= Nul then - Create (OutB, Out_File, S (FileB)); - end if; - - Anchored_Mode := True; - - -- Copy initial part of template to spec and body - - loop - Line := Get_Line (InT); - - -- Skip lines describing the template - - if Match (Line, "-- This file is a template") then - loop - Line := Get_Line (InT); - exit when Line = ""; - end loop; - end if; - - -- Loop keeps going until "package" keyword written - - exit when Match (Line, "package"); - - -- Deal with WITH lines, writing to body or spec as appropriate - - if Match (Line, Body_Only, M) then - Replace (M, X); - WriteB (Line); - - elsif Match (Line, Spec_Only, M) then - Replace (M, X); - WriteS (Line); - - -- Change header from Template to Spec and write to spec file - - else - if Match (Line, Templ, M) then - Replace (M, A & " S p e c "); - end if; - - WriteS (Line); - - -- Write header line to body file - - if Match (Line, Spec, M) then - Replace (M, A & "B o d y"); - end if; - - WriteB (Line); - end if; - end loop; - - -- Package line reached - - WriteS ("package Nmake is"); - WriteB ("package body Nmake is"); - WriteB (""); - - -- Copy rest of lines up to template insert point to spec only - - loop - Line := Get_Line (InT); - exit when Match (Line, "!!TEMPLATE INSERTION POINT"); - WriteS (Line); - end loop; - - -- Here we are doing the actual insertions, loop through node types - - loop - Line := Get_Line (InS); - - if Match (Line, Node_Hdr) - and then not Match (Node, Punc) - and then Node /= "Unused" - then - exit when Node = "Empty"; - Prevl := " function Make_" & Node & " (Sloc : Source_Ptr"; - Arg_List := Nul; - - -- Loop through fields of one node - - loop - Line := Get_Line (InS); - exit when Line = ""; - - if Match (Line, Binop) then - WriteBS (Prevl & ';'); - Append (Arg_List, "Left_Opnd,Right_Opnd,"); - WriteBS ( - " " & Rpad ("Left_Opnd", NWidth) & " : Node_Id;"); - Prevl := - " " & Rpad ("Right_Opnd", NWidth) & " : Node_Id"; - - elsif Match (Line, Unop) then - WriteBS (Prevl & ';'); - Append (Arg_List, "Right_Opnd,"); - Prevl := " " & Rpad ("Right_Opnd", NWidth) & " : Node_Id"; - - elsif Match (Line, Syn) then - if Synonym /= "Prev_Ids" - and then Synonym /= "More_Ids" - and then Synonym /= "Comes_From_Source" - and then Synonym /= "Paren_Count" - and then not Match (Field, Sem_Field) - and then not Match (Field, Lib_Field) - then - Match (Field, Get_Field); - - if Field = "Str" then - Field := V_String_Id; - elsif Field = "Node" then - Field := V_Node_Id; - elsif Field = "Name" then - Field := V_Name_Id; - elsif Field = "List" then - Field := V_List_Id; - elsif Field = "Elist" then - Field := V_Elist_Id; - elsif Field = "Flag" then - Field := V_Boolean; - end if; - - if Field = "Boolean" then - Default := V ("False"); - else - Default := Nul; - end if; - - Match (Comment, Get_Dflt); - - WriteBS (Prevl & ';'); - Append (Arg_List, Synonym & ','); - Rpad (Synonym, NWidth); - - if Default = "" then - Prevl := " " & Synonym & " : " & Field; - else - Prevl := - " " & Synonym & " : " & Field & " := " & Default; - end if; - end if; - end if; - end loop; - - WriteBS (Prevl & ')'); - WriteS (" return Node_Id;"); - WriteS (" pragma Inline (Make_" & Node & ");"); - WriteB (" return Node_Id"); - WriteB (" is"); - WriteB (" N : constant Node_Id :="); - - if Match (Node, "Defining_Identifier") or else - Match (Node, "Defining_Character") or else - Match (Node, "Defining_Operator") - then - WriteB (" New_Entity (N_" & Node & ", Sloc);"); - else - WriteB (" New_Node (N_" & Node & ", Sloc);"); - end if; - - WriteB (" begin"); - - while Match (Arg_List, Next_Arg, "") loop - if Length (Arg) < NWidth then - WriteB (" Set_" & Arg & " (N, " & Arg & ");"); - else - WriteB (" Set_" & Arg); - WriteB (" (N, " & Arg & ");"); - end if; - end loop; - - if Match (Node, Op_Node) then - if Node = "Op_Plus" then - WriteB (" Set_Chars (N, Name_Op_Add);"); - - elsif Node = "Op_Minus" then - WriteB (" Set_Chars (N, Name_Op_Subtract);"); - - elsif Match (Op_Name, Shft_Rot) then - WriteB (" Set_Chars (N, Name_" & Op_Name & ");"); - - else - WriteB (" Set_Chars (N, Name_" & Node & ");"); - end if; - - if not Match (Op_Name, No_Ent) then - WriteB (" Set_Entity (N, Standard_" & Node & ");"); - end if; - end if; - - WriteB (" return N;"); - WriteB (" end Make_" & Node & ';'); - WriteBS (""); - end if; - end loop; - - WriteBS ("end Nmake;"); - -exception - - when Err => - Put_Line (Standard_Error, "usage: xnmake [-b] [-s] [filename]"); - Set_Exit_Status (1); - -end XNmake; -- cgit v1.1