From: Arnaud Charlet Date: Wed, 1 Jan 2020 20:19:05 +0000 (-0500) Subject: [Ada] Remove ASIS tree generation X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=ba2034610fcc0d56dd52cb20c26f9ab1997b520e;p=gcc.git [Ada] Remove ASIS tree generation 2020-06-03 Arnaud Charlet gcc/ada/ * aspects.adb, aspects.ads, atree.adb, atree.ads, elists.adb, elists.ads, fname.adb, fname.ads, gnat1drv.adb, lib.adb, lib.ads, namet.adb, namet.ads, nlists.adb, nlists.ads, opt.adb, opt.ads, osint-c.adb, osint-c.ads, repinfo.adb, repinfo.ads, sem_aux.adb, sem_aux.ads, sinput.adb, sinput.ads, stand.ads, stringt.adb, stringt.ads, switch-c.adb, table.adb, table.ads, uintp.adb, uintp.ads, urealp.adb, urealp.ads (Tree_Read, Tree_Write): Remove generation of ASIS trees. * doc/gnat_ugn/building_executable_programs_with_gnat.rst: Remove -gnatt and -gnatct documentation. * gnat_ugn.texi: Regenerate. * tree_in.ads, tree_in.adb, tree_io.ads, tree_io.adb, tree_gen.ads, tree_gen.adb, stand.adb: Remove. * gcc-interface/Makefile.in, gcc-interface/Make-lang.in: Remove references to tree_gen.o tree_in.o tree_io.o. --- diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 23a31165109..2968e21be54 100644 --- a/gcc/ada/aspects.adb +++ b/gcc/ada/aspects.adb @@ -33,7 +33,6 @@ with Atree; use Atree; with Einfo; use Einfo; with Nlists; use Nlists; with Sinfo; use Sinfo; -with Tree_IO; use Tree_IO; with GNAT.HTable; @@ -70,16 +69,6 @@ package body Aspects is Aspect_Variable_Indexing => True, others => False); - procedure Set_Aspect_Specifications_No_Check (N : Node_Id; L : List_Id); - -- Same as Set_Aspect_Specifications, but does not contain the assertion - -- that checks that N does not already have aspect specifications. This - -- subprogram is supposed to be used as a part of Tree_Read. When reading - -- tree, first read nodes with their basic properties (as Atree.Tree_Read), - -- this includes reading the Has_Aspects flag for each node, then we reed - -- all the list tables and only after that we call Tree_Read for Aspects. - -- That is, when reading the tree, the list of aspects is attached to the - -- node that already has Has_Aspects flag set ON. - ------------------------------------------ -- Hash Table for Aspect Specifications -- ------------------------------------------ @@ -662,53 +651,6 @@ package body Aspects is Aspect_Specifications_Hash_Table.Set (N, L); end Set_Aspect_Specifications; - ---------------------------------------- - -- Set_Aspect_Specifications_No_Check -- - ---------------------------------------- - - procedure Set_Aspect_Specifications_No_Check (N : Node_Id; L : List_Id) is - begin - pragma Assert (Permits_Aspect_Specifications (N)); - pragma Assert (L /= No_List); - - Set_Has_Aspects (N); - Set_Parent (L, N); - Aspect_Specifications_Hash_Table.Set (N, L); - end Set_Aspect_Specifications_No_Check; - - --------------- - -- Tree_Read -- - --------------- - - procedure Tree_Read is - Node : Node_Id; - List : List_Id; - begin - loop - Tree_Read_Int (Int (Node)); - Tree_Read_Int (Int (List)); - exit when List = No_List; - Set_Aspect_Specifications_No_Check (Node, List); - end loop; - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - procedure Tree_Write is - Node : Node_Id := Empty; - List : List_Id; - begin - Aspect_Specifications_Hash_Table.Get_First (Node, List); - loop - Tree_Write_Int (Int (Node)); - Tree_Write_Int (Int (List)); - exit when List = No_List; - Aspect_Specifications_Hash_Table.Get_Next (Node, List); - end loop; - end Tree_Write; - -- Package initialization sets up Aspect Id hash table begin diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 60ffb2ccdfa..5766cdd5540 100644 --- a/gcc/ada/aspects.ads +++ b/gcc/ada/aspects.ads @@ -959,10 +959,4 @@ package Aspects is -- node that has its Has_Aspects flag set True on entry, or with L being an -- empty list or No_List. - procedure Tree_Read; - -- Reads contents of Aspect_Specifications hash table from the tree file - - procedure Tree_Write; - -- Writes contents of Aspect_Specifications hash table to the tree file - end Aspects; diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index d4911e7b1a2..5619f09046f 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -42,7 +42,6 @@ with Nlists; use Nlists; with Opt; use Opt; with Output; use Output; with Sinput; use Sinput; -with Tree_IO; use Tree_IO; with GNAT.Heap_Sort_G; @@ -2686,32 +2685,6 @@ package body Atree is Discard := Traverse (Node); end Traverse_Proc; - --------------- - -- Tree_Read -- - --------------- - - procedure Tree_Read is - begin - Tree_Read_Int (Node_Count); - Nodes.Tree_Read; - Flags.Tree_Read; - Orig_Nodes.Tree_Read; - Paren_Counts.Tree_Read; - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - procedure Tree_Write is - begin - Tree_Write_Int (Node_Count); - Nodes.Tree_Write; - Flags.Tree_Write; - Orig_Nodes.Tree_Write; - Paren_Counts.Tree_Write; - end Tree_Write; - ------------------------------ -- Unchecked Access Package -- ------------------------------ diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index 3aa22e6ac16..f9ebc38e554 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -406,8 +406,7 @@ package Atree is procedure Initialize; -- Called at the start of compilation to initialize the allocation of -- the node and list tables and make the standard entries for Empty, - -- Error and Error_List. Note that Initialize must not be called if - -- Tree_Read is used. + -- Error and Error_List. procedure Lock; -- Called before the back end is invoked to lock the nodes table @@ -425,15 +424,6 @@ package Atree is -- Called to unlock entity modifications when assertions are enabled; if -- assertions are not enabled calling this subprogram has no effect. - procedure Tree_Read; - -- Initializes internal tables from current tree file using the relevant - -- Table.Tree_Read routines. Note that Initialize should not be called if - -- Tree_Read is used. Tree_Read includes all necessary initialization. - - procedure Tree_Write; - -- Writes out internal tables to current tree file using the relevant - -- Table.Tree_Write routines. - function New_Node (New_Node_Kind : Node_Kind; New_Sloc : Source_Ptr) return Node_Id; diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst index 7f5dabe75fb..368cb8666f2 100644 --- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst +++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst @@ -1910,10 +1910,6 @@ Alphabetical List of All Switches Note that this option should be used only for compiling -- the code is likely to malfunction at run time. - Note that when :switch:`-gnatct` is used to generate trees for input - into ASIS tools, these representation clauses are removed - from the tree and ignored. This means that the tool will not see them. - .. index:: -gnatjnn (gcc) @@ -2112,12 +2108,6 @@ Alphabetical List of All Switches Print package Standard. -.. index:: -gnatt (gcc) - -:switch:`-gnatt` - Generate tree output file. - - .. index:: -gnatT (gcc) :switch:`-gnatT{nnn}` @@ -2600,14 +2590,6 @@ format: implies :switch:`-gnatq`, since the semantic phase must be run to get a meaningful ALI file. - In addition, if :switch:`-gnatt` is also specified, then the tree file is - generated even if there are illegalities. It may be useful in this case - to also specify :switch:`-gnatq` to ensure that full semantic processing - occurs. The resulting tree file can be processed by ASIS, for the purpose - of providing partial information about illegal units, but if the error - causes the tree to be badly malformed, then ASIS may crash during the - analysis. - When :switch:`-gnatQ` is used and the generated :file:`ALI` file is marked as being in error, ``gnatmake`` will attempt to recompile the source when it finds such an :file:`ALI` file, including with switch :switch:`-gnatc`. @@ -5695,21 +5677,6 @@ Subprogram Inlining Control Auxiliary Output Control ------------------------ -.. index:: -gnatt (gcc) -.. index:: Writing internal trees -.. index:: Internal trees, writing to file - -:switch:`-gnatt` - Causes GNAT to write the internal tree for a unit to a file (with the - extension :file:`.adt`. - This not normally required, but is used by separate analysis tools. - Typically - these tools do the necessary compilations automatically, so you should - not have to specify this switch in normal operation. - Note that the combination of switches :switch:`-gnatct` - generates a tree in the form required by ASIS applications. - - .. index:: -gnatu (gcc) :switch:`-gnatu` diff --git a/gcc/ada/elists.adb b/gcc/ada/elists.adb index ecbd0472128..90bcd2ee225 100644 --- a/gcc/ada/elists.adb +++ b/gcc/ada/elists.adb @@ -580,26 +580,6 @@ package body Elists is Elmts.Table (Elmt).Node := New_Node; end Replace_Elmt; - --------------- - -- Tree_Read -- - --------------- - - procedure Tree_Read is - begin - Elists.Tree_Read; - Elmts.Tree_Read; - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - procedure Tree_Write is - begin - Elists.Tree_Write; - Elmts.Tree_Write; - end Tree_Write; - ------------ -- Unlock -- ------------ diff --git a/gcc/ada/elists.ads b/gcc/ada/elists.ads index 802d67dc0ef..12672a69385 100644 --- a/gcc/ada/elists.ads +++ b/gcc/ada/elists.ads @@ -57,8 +57,7 @@ package Elists is procedure Initialize; -- Initialize allocation of element list tables. Called at the start of - -- compiling each new main source file. Note that Initialize must not be - -- called if Tree_Read is used. + -- compiling each new main source file. procedure Lock; -- Lock tables used for element lists before calling backend @@ -66,15 +65,6 @@ package Elists is procedure Unlock; -- Unlock list tables, in cases where the back end needs to modify them - procedure Tree_Read; - -- Initializes internal tables from current tree file using the relevant - -- Table.Tree_Read routines. Note that Initialize should not be called if - -- Tree_Read is used. Tree_Read includes all necessary initialization. - - procedure Tree_Write; - -- Writes out internal tables to current tree file using the relevant - -- Table.Tree_Write routines. - function Last_Elist_Id return Elist_Id; -- Returns Id of last allocated element list header diff --git a/gcc/ada/fname.adb b/gcc/ada/fname.adb index 7923a5ea15d..ad316eb4b72 100644 --- a/gcc/ada/fname.adb +++ b/gcc/ada/fname.adb @@ -29,34 +29,8 @@ -- -- ------------------------------------------------------------------------------ -with Alloc; -with Table; -with Types; use Types; - package body Fname is - ----------------------------- - -- Dummy Table Definitions -- - ----------------------------- - - -- The following table was used in old versions of the compiler. We retain - -- the declarations here for compatibility with old tree files. The new - -- version of the compiler does not use this table, and will write out a - -- dummy empty table for Tree_Write. - - type SFN_Entry is record - U : Unit_Name_Type; - F : File_Name_Type; - end record; - - package SFN_Table is new Table.Table ( - Table_Component_Type => SFN_Entry, - Table_Index_Type => Int, - Table_Low_Bound => 0, - Table_Initial => Alloc.SFN_Table_Initial, - Table_Increment => Alloc.SFN_Table_Increment, - Table_Name => "Fname_Dummy_Table"); - function Has_Internal_Extension (Fname : String) return Boolean; pragma Inline (Has_Internal_Extension); -- True if the extension is appropriate for an internal/predefined unit. @@ -268,22 +242,4 @@ package body Fname is return Result; end Is_Predefined_Renaming_File_Name; - --------------- - -- Tree_Read -- - --------------- - - procedure Tree_Read is - begin - SFN_Table.Tree_Read; - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - procedure Tree_Write is - begin - SFN_Table.Tree_Write; - end Tree_Write; - end Fname; diff --git a/gcc/ada/fname.ads b/gcc/ada/fname.ads index df5751709ae..06a77f1a100 100644 --- a/gcc/ada/fname.ads +++ b/gcc/ada/fname.ads @@ -100,14 +100,4 @@ package Fname is function Is_GNAT_File_Name (Fname : File_Name_Type) return Boolean; -- True for units in the GNAT hierarchy - procedure Tree_Read; - -- Dummy procedure (reads dummy table values from tree file) - - procedure Tree_Write; - -- Writes out internal tables to current tree file using Tree_Write - -- This is actually a dummy routine, since the relevant table is - -- no longer used, but we retain it for now, to avoid a tree file - -- incompatibility with the 3.13 compiler. Should be removed for - -- the 3.14a release ??? - end Fname; diff --git a/gcc/ada/gcc-interface/Make-lang.in b/gcc/ada/gcc-interface/Make-lang.in index acbe2b877ca..2e0f6b42e64 100644 --- a/gcc/ada/gcc-interface/Make-lang.in +++ b/gcc/ada/gcc-interface/Make-lang.in @@ -472,9 +472,6 @@ GNAT_ADA_OBJS = \ ada/table.o \ ada/targparm.o \ ada/tbuild.o \ - ada/tree_gen.o \ - ada/tree_in.o \ - ada/tree_io.o \ ada/treepr.o \ ada/treeprs.o \ ada/ttypes.o \ @@ -632,7 +629,6 @@ GNATBIND_OBJS = \ ada/table.o \ ada/targext.o \ ada/targparm.o \ - ada/tree_io.o \ ada/types.o \ ada/uintp.o \ ada/uname.o \ @@ -1040,7 +1036,7 @@ ada/sdefault.o : ada/libgnat/ada.ads ada/libgnat/a-except.ads ada/libgnat/a-uncc ada/libgnat/s-exctab.ads ada/libgnat/s-memory.ads ada/libgnat/s-os_lib.ads ada/libgnat/s-parame.ads \ ada/libgnat/s-stalib.ads ada/libgnat/s-strops.ads ada/libgnat/s-sopco3.ads ada/libgnat/s-sopco4.ads \ ada/libgnat/s-sopco5.ads ada/libgnat/s-string.ads ada/libgnat/s-traent.ads ada/libgnat/s-unstyp.ads \ - ada/libgnat/s-wchcon.ads ada/libgnat/system.ads ada/table.adb ada/table.ads ada/tree_io.ads \ + ada/libgnat/s-wchcon.ads ada/libgnat/system.ads ada/table.adb ada/table.ads \ ada/types.ads ada/libgnat/unchdeal.ads ada/libgnat/unchconv.ads # Special flags - see gcc-interface/Makefile.in for the template. diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index 25ebc3d21d4..6177d7569e3 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -318,7 +318,7 @@ GNATLINK_OBJS = gnatlink.o \ a-except.o ali.o alloc.o butil.o casing.o csets.o debug.o fmap.o fname.o \ gnatvsn.o hostparm.o indepsw.o interfac.o i-c.o i-cstrin.o namet.o opt.o \ osint.o output.o rident.o s-exctab.o s-secsta.o s-stalib.o s-stoele.o \ - sdefault.o snames.o stylesw.o switch.o system.o table.o targparm.o tree_io.o \ + sdefault.o snames.o stylesw.o switch.o system.o table.o targparm.o \ types.o validsw.o widechar.o GNATMAKE_OBJS = a-except.o ali.o ali-util.o aspects.o s-casuti.o alloc.o \ @@ -330,7 +330,7 @@ GNATMAKE_OBJS = a-except.o ali.o ali-util.o aspects.o s-casuti.o alloc.o \ s-secsta.o s-stalib.o s-stoele.o scans.o scng.o sdefault.o sfn_scan.o \ s-purexc.o s-htable.o scil_ll.o sem_aux.o sinfo.o sinput.o sinput-c.o \ snames.o stand.o stringt.o styleg.o stylesw.o system.o validsw.o \ - switch.o switch-m.o table.o targparm.o tempdir.o tree_io.o types.o uintp.o \ + switch.o switch-m.o table.o targparm.o tempdir.o types.o uintp.o \ uname.o urealp.o usage.o widechar.o \ $(EXTRA_GNATMAKE_OBJS) diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 0549eefd39d..365ddd0f669 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -74,7 +74,6 @@ with Stringt; with Stylesw; use Stylesw; with Targparm; use Targparm; with Tbuild; -with Tree_Gen; with Treepr; use Treepr; with Ttypes; with Types; use Types; @@ -380,7 +379,7 @@ procedure Gnat1drv is -- Always perform semantics and generate ali files in CodePeer mode, -- so that a gnatmake -c -k will proceed further when possible. - Force_ALI_Tree_File := True; + Force_ALI_File := True; Try_Semantics := True; -- Make the Ada front end more liberal so that the compiler will @@ -1271,9 +1270,8 @@ begin -- Generate ALI file if specially requested - if Opt.Force_ALI_Tree_File then + if Opt.Force_ALI_File then Write_ALI (Object => False); - Tree_Gen; end if; Exit_Program (E_Errors); @@ -1308,7 +1306,6 @@ begin Treepr.Tree_Dump; Errout.Finalize (Last_Call => True); Errout.Output_Messages; - Tree_Gen; Namet.Finalize; Check_Rep_Info; @@ -1461,7 +1458,7 @@ begin -- Force generation of ALI file, for backward compatibility - Opt.Force_ALI_Tree_File := True; + Opt.Force_ALI_File := True; elsif Main_Unit_Kind = N_Subunit then Write_Str (" (subunit)"); @@ -1483,7 +1480,7 @@ begin -- Force generation of ALI file, for backward compatibility - Opt.Force_ALI_Tree_File := True; + Opt.Force_ALI_File := True; -- Only other case is a package spec @@ -1499,7 +1496,6 @@ begin Errout.Finalize (Last_Call => True); Errout.Output_Messages; Treepr.Tree_Dump; - Tree_Gen; -- Generate ALI file if specially requested, or for missing subunits, -- subunits or predefined generic. For ignored ghost code, the object @@ -1508,7 +1504,7 @@ begin -- an object file without an ALI file. if Is_Ignored_Ghost_Unit (Main_Unit_Node) - or else Opt.Force_ALI_Tree_File + or else Opt.Force_ALI_File then Write_ALI (Object => Is_Ignored_Ghost_Unit (Main_Unit_Node)); end if; @@ -1523,8 +1519,8 @@ begin Exit_Program (Ecode); end if; - -- In -gnatc mode we only do annotation if -gnatt or -gnatR is also set, - -- or if -gnatwz is enabled (default setting) and there is an unchecked + -- In -gnatc mode we only do annotation if -gnatR is also set, or if + -- -gnatwz is enabled (default setting) and there is an unchecked -- conversion that involves a type whose size is not statically known, -- as indicated by Back_Annotate_Rep_Info being set to True. @@ -1547,7 +1543,6 @@ begin Errout.Output_Messages; Write_ALI (Object => False); Tree_Dump; - Tree_Gen; Namet.Finalize; if not (Generate_SCIL or GNATprove_Mode) then @@ -1670,11 +1665,8 @@ begin -- fact result in further tree decoration from the original tree file. -- Note that we dump the tree just before generating it, so that the -- dump will exactly reflect what is written out. - -- Should we remove Tree_Dump completely now that ASIS is no longer - -- supported??? Treepr.Tree_Dump; - Tree_Gen; -- Finalize name table and we are all done diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index 861a92ec2d1..703b7378310 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -21,7 +21,7 @@ @copying @quotation -GNAT User's Guide for Native Platforms , Dec 10, 2019 +GNAT User's Guide for Native Platforms , May 04, 2020 AdaCore @@ -9686,10 +9686,6 @@ Object_Size, Scalar_Storage_Order, Size, Small, Stream_Size, and Value_Size. Pragma Default_Scalar_Storage_Order is also ignored. Note that this option should be used only for compiling -- the code is likely to malfunction at run time. - -Note that when @code{-gnatct} is used to generate trees for input -into ASIS tools, these representation clauses are removed -from the tree and ignored. This means that the tool will not see them. @end table @geindex -gnatjnn (gcc) @@ -10019,16 +10015,6 @@ Syntax check only. Print package Standard. @end table -@geindex -gnatt (gcc) - - -@table @asis - -@item @code{-gnatt} - -Generate tree output file. -@end table - @geindex -gnatT (gcc) @@ -10715,14 +10701,6 @@ environments) that are driven from the @code{ALI} file. This switch implies @code{-gnatq}, since the semantic phase must be run to get a meaningful ALI file. -In addition, if @code{-gnatt} is also specified, then the tree file is -generated even if there are illegalities. It may be useful in this case -to also specify @code{-gnatq} to ensure that full semantic processing -occurs. The resulting tree file can be processed by ASIS, for the purpose -of providing partial information about illegal units, but if the error -causes the tree to be badly malformed, then ASIS may crash during the -analysis. - When @code{-gnatQ} is used and the generated @code{ALI} file is marked as being in error, @code{gnatmake} will attempt to recompile the source when it finds such an @code{ALI} file, including with switch @code{-gnatc}. @@ -14899,28 +14877,6 @@ inlining, but that is no longer the case. @subsection Auxiliary Output Control -@geindex -gnatt (gcc) - -@geindex Writing internal trees - -@geindex Internal trees -@geindex writing to file - - -@table @asis - -@item @code{-gnatt} - -Causes GNAT to write the internal tree for a unit to a file (with the -extension @code{.adt}. -This not normally required, but is used by separate analysis tools. -Typically -these tools do the necessary compilations automatically, so you should -not have to specify this switch in normal operation. -Note that the combination of switches @code{-gnatct} -generates a tree in the form required by ASIS applications. -@end table - @geindex -gnatu (gcc) diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index 925aeaf4580..3a42e02209e 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -43,7 +43,6 @@ with Sinfo; use Sinfo; with Sinput; use Sinput; with Stand; use Stand; with Stringt; use Stringt; -with Tree_IO; use Tree_IO; with Uname; use Uname; with Widechar; use Widechar; @@ -1254,50 +1253,6 @@ package body Lib is TSN := TSN + 1; end Synchronize_Serial_Number; - --------------- - -- Tree_Read -- - --------------- - - procedure Tree_Read is - N : Nat; - S : String_Ptr; - - begin - Units.Tree_Read; - - -- Read Compilation_Switches table. First release the memory occupied - -- by the previously loaded switches. - - for J in Compilation_Switches.First .. Compilation_Switches.Last loop - Free (Compilation_Switches.Table (J)); - end loop; - - Tree_Read_Int (N); - Compilation_Switches.Set_Last (N); - - for J in 1 .. N loop - Tree_Read_Str (S); - Compilation_Switches.Table (J) := S; - end loop; - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - procedure Tree_Write is - begin - Units.Tree_Write; - - -- Write Compilation_Switches table - - Tree_Write_Int (Compilation_Switches.Last); - - for J in 1 .. Compilation_Switches.Last loop - Tree_Write_Str (Compilation_Switches.Table (J)); - end loop; - end Tree_Write; - -------------------- -- Unit_Name_Hash -- -------------------- diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index 47b6867b6c1..c4ace09e353 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -755,14 +755,6 @@ package Lib is -- important to keep the serial numbers synchronized in the two cases (e.g. -- when the references in a package and a client must be kept consistent). - procedure Tree_Read; - -- Initializes internal tables from current tree file using the relevant - -- Table.Tree_Read routines. - - procedure Tree_Write; - -- Writes out internal tables to current tree file using the relevant - -- Table.Tree_Write routines. - procedure Unlock; -- Unlock internal tables, in cases where the back end needs to modify them @@ -1002,8 +994,7 @@ private -- This table is set as part of the compiler argument scanning in -- Back_End. It can also be reset in -gnatc mode from the data in an - -- existing ali file, and is read and written by the Tree_Read and - -- Tree_Write routines. + -- existing ali file. package Compilation_Switches is new Table.Table ( Table_Component_Type => String_Ptr, diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb index 70f499303b9..60c1050522e 100644 --- a/gcc/ada/namet.adb +++ b/gcc/ada/namet.adb @@ -33,11 +33,9 @@ -- source file must be properly reflected in the C header file namet.h -- which is created manually from namet.ads and namet.adb. -with Debug; use Debug; -with Opt; use Opt; -with Output; use Output; -with System; use System; -with Tree_IO; use Tree_IO; +with Debug; use Debug; +with Opt; use Opt; +with Output; use Output; with Widechar; with Interfaces; use Interfaces; @@ -1729,34 +1727,6 @@ package body Namet is return Buf.Chars (1 .. Buf.Length); end To_String; - --------------- - -- Tree_Read -- - --------------- - - procedure Tree_Read is - begin - Name_Chars.Tree_Read; - Name_Entries.Tree_Read; - - Tree_Read_Data - (Hash_Table'Address, - Hash_Table'Length * (Hash_Table'Component_Size / Storage_Unit)); - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - procedure Tree_Write is - begin - Name_Chars.Tree_Write; - Name_Entries.Tree_Write; - - Tree_Write_Data - (Hash_Table'Address, - Hash_Table'Length * (Hash_Table'Component_Size / Storage_Unit)); - end Tree_Write; - ------------ -- Unlock -- ------------ diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index df90be73235..670cdc9e2b6 100644 --- a/gcc/ada/namet.ads +++ b/gcc/ada/namet.ads @@ -548,15 +548,6 @@ package Namet is -- Unlocks the name table to allow use of the extra space reserved by the -- call to Lock. See gnat1drv for details of the need for this. - procedure Tree_Read; - -- Initializes internal tables from current tree file using the relevant - -- Table.Tree_Read routines. Note that Initialize should not be called if - -- Tree_Read is used. Tree_Read includes all necessary initialization. - - procedure Tree_Write; - -- Writes out internal tables to current tree file using the relevant - -- Table.Tree_Write routines. - procedure Write_Name (Id : Valid_Name_Id); -- Write_Name writes the characters of the specified name using the -- standard output procedures in package Output. The name is written diff --git a/gcc/ada/nlists.adb b/gcc/ada/nlists.adb index 0f9884d8aaa..a51b191c8da 100644 --- a/gcc/ada/nlists.adb +++ b/gcc/ada/nlists.adb @@ -141,8 +141,7 @@ package body Nlists is Next_Node.Set_Last (N); Prev_Node.Set_Last (N); - -- Make sure we have no uninitialized junk in any new entires added. - -- This ensures that Tree_Gen will not write out any uninitialized junk. + -- Make sure we have no uninitialized junk in any new entries added. for J in Old_Last + 1 .. N loop Next_Node.Table (J) := Empty; @@ -1470,29 +1469,6 @@ package body Nlists is Prev_Node.Table (Node) := To; end Set_Prev; - --------------- - -- Tree_Read -- - --------------- - - procedure Tree_Read is - begin - pragma Assert (not Locked); - Lists.Tree_Read; - Next_Node.Tree_Read; - Prev_Node.Tree_Read; - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - procedure Tree_Write is - begin - Lists.Tree_Write; - Next_Node.Tree_Write; - Prev_Node.Tree_Write; - end Tree_Write; - ------------ -- Unlock -- ------------ diff --git a/gcc/ada/nlists.ads b/gcc/ada/nlists.ads index e5b204972ff..67fc6613517 100644 --- a/gcc/ada/nlists.ads +++ b/gcc/ada/nlists.ads @@ -337,8 +337,7 @@ package Nlists is procedure Initialize; -- Called at the start of compilation of each new main source file to - -- initialize the allocation of the list table. Note that Initialize - -- must not be called if Tree_Read is used. + -- initialize the allocation of the list table. procedure Lock; -- Called to lock tables before back end is called @@ -355,15 +354,6 @@ package Nlists is -- Called to unlock list contents when assertions are enabled; if -- assertions are not enabled calling this subprogram has no effect. - procedure Tree_Read; - -- Initializes internal tables from current tree file using the relevant - -- Table.Tree_Read routines. Note that Initialize should not be called if - -- Tree_Read is used. Tree_Read includes all necessary initialization. - - procedure Tree_Write; - -- Writes out internal tables to current tree file using the relevant - -- Table.Tree_Write routines. - function Parent (List : List_Id) return Node_Or_Entity_Id; pragma Inline (Parent); -- Node lists may have a parent in the same way as a node. The function diff --git a/gcc/ada/opt.adb b/gcc/ada/opt.adb index ca1cfe1be11..2d21b56570d 100644 --- a/gcc/ada/opt.adb +++ b/gcc/ada/opt.adb @@ -29,15 +29,8 @@ -- -- ------------------------------------------------------------------------------ -with Gnatvsn; use Gnatvsn; -with System; use System; -with Tree_IO; use Tree_IO; - package body Opt is - SU : constant := Storage_Unit; - -- Shorthand for System.Storage_Unit - ------------------------- -- Back_End_Exceptions -- ------------------------- @@ -312,123 +305,4 @@ package body Opt is Polling_Required := Polling_Required_Config; end Set_Config_Switches; - --------------- - -- Tree_Read -- - --------------- - - procedure Tree_Read is - Tree_Version_String_Len : Nat; - Ada_Version_Config_Val : Nat; - Ada_Version_Explicit_Config_Val : Nat; - Assertions_Enabled_Config_Val : Nat; - - begin - Tree_Read_Bool (Address_Is_Private); - Tree_Read_Bool (Brief_Output); - Tree_Read_Bool (GNAT_Mode); - Tree_Read_Char (Identifier_Character_Set); - Tree_Read_Bool (Ignore_Rep_Clauses); - Tree_Read_Bool (Ignore_Style_Checks_Pragmas); - Tree_Read_Int (Maximum_File_Name_Length); - Tree_Read_Data (Suppress_Options'Address, - (Suppress_Options'Size + SU - 1) / SU); - Tree_Read_Bool (Verbose_Mode); - Tree_Read_Data (Warning_Mode'Address, - (Warning_Mode'Size + SU - 1) / SU); - Tree_Read_Int (Ada_Version_Config_Val); - Tree_Read_Int (Ada_Version_Explicit_Config_Val); - Tree_Read_Int (Assertions_Enabled_Config_Val); - Tree_Read_Bool (All_Errors_Mode); - Tree_Read_Bool (Assertions_Enabled); - Tree_Read_Bool (Check_Float_Overflow); - Tree_Read_Int (Int (Check_Policy_List)); - Tree_Read_Int (Int (Default_Pool)); - Tree_Read_Bool (Full_List); - - Ada_Version_Config := - Ada_Version_Type'Val (Ada_Version_Config_Val); - Ada_Version_Explicit_Config := - Ada_Version_Type'Val (Ada_Version_Explicit_Config_Val); - Assertions_Enabled_Config := - Boolean'Val (Assertions_Enabled_Config_Val); - - -- Read version string: we have to get the length first - - Tree_Read_Int (Tree_Version_String_Len); - - declare - Tmp : String (1 .. Integer (Tree_Version_String_Len)); - begin - Tree_Read_Data - (Tmp'Address, Tree_Version_String_Len); - System.Strings.Free (Tree_Version_String); - Free (Tree_Version_String); - Tree_Version_String := new String'(Tmp); - end; - - Tree_Read_Data (Distribution_Stub_Mode'Address, - (Distribution_Stub_Mode'Size + SU - 1) / Storage_Unit); - Tree_Read_Bool (Inline_Active); - Tree_Read_Bool (Inline_Processing_Required); - Tree_Read_Bool (List_Units); - Tree_Read_Int (Multiple_Unit_Index); - Tree_Read_Bool (Configurable_Run_Time_Mode); - Tree_Read_Data (Operating_Mode'Address, - (Operating_Mode'Size + SU - 1) / Storage_Unit); - Tree_Read_Bool (Suppress_Checks); - Tree_Read_Bool (Try_Semantics); - Tree_Read_Data (Wide_Character_Encoding_Method'Address, - (Wide_Character_Encoding_Method'Size + SU - 1) / SU); - Tree_Read_Bool (Upper_Half_Encoding); - Tree_Read_Bool (Force_ALI_Tree_File); - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - procedure Tree_Write is - Version_String : String := Gnat_Version_String; - - begin - Tree_Write_Bool (Address_Is_Private); - Tree_Write_Bool (Brief_Output); - Tree_Write_Bool (GNAT_Mode); - Tree_Write_Char (Identifier_Character_Set); - Tree_Write_Bool (Ignore_Rep_Clauses); - Tree_Write_Bool (Ignore_Style_Checks_Pragmas); - Tree_Write_Int (Maximum_File_Name_Length); - Tree_Write_Data (Suppress_Options'Address, - (Suppress_Options'Size + SU - 1) / SU); - Tree_Write_Bool (Verbose_Mode); - Tree_Write_Data (Warning_Mode'Address, - (Warning_Mode'Size + SU - 1) / Storage_Unit); - Tree_Write_Int (Ada_Version_Type'Pos (Ada_Version_Config)); - Tree_Write_Int (Ada_Version_Type'Pos (Ada_Version_Explicit_Config)); - Tree_Write_Int (Boolean'Pos (Assertions_Enabled_Config)); - Tree_Write_Bool (All_Errors_Mode); - Tree_Write_Bool (Assertions_Enabled); - Tree_Write_Bool (Check_Float_Overflow); - Tree_Write_Int (Int (Check_Policy_List)); - Tree_Write_Int (Int (Default_Pool)); - Tree_Write_Bool (Full_List); - Tree_Write_Int (Int (Version_String'Length)); - Tree_Write_Data (Version_String'Address, Version_String'Length); - Tree_Write_Data (Distribution_Stub_Mode'Address, - (Distribution_Stub_Mode'Size + SU - 1) / SU); - Tree_Write_Bool (Inline_Active); - Tree_Write_Bool (Inline_Processing_Required); - Tree_Write_Bool (List_Units); - Tree_Write_Int (Multiple_Unit_Index); - Tree_Write_Bool (Configurable_Run_Time_Mode); - Tree_Write_Data (Operating_Mode'Address, - (Operating_Mode'Size + SU - 1) / SU); - Tree_Write_Bool (Suppress_Checks); - Tree_Write_Bool (Try_Semantics); - Tree_Write_Data (Wide_Character_Encoding_Method'Address, - (Wide_Character_Encoding_Method'Size + SU - 1) / SU); - Tree_Write_Bool (Upper_Half_Encoding); - Tree_Write_Bool (Force_ALI_Tree_File); - end Tree_Write; - end Opt; diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index d60380db45a..ebd5a78bb1b 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -242,9 +242,9 @@ package Opt is -- GNAT -- If set True, enables back annotation of representation information -- by gigi, even in -gnatc mode. This is set True by the use of -gnatR - -- (list representation information) or -gnatt (generate tree). It is - -- also set true if certain Unchecked_Conversion instantiations require - -- checking based on annotated values. + -- (list representation information). It is also set true if certain + -- Unchecked_Conversion instantiations require checking based on annotated + -- values. Back_End_Handles_Limited_Types : Boolean; -- This flag is set true if the back end can properly handle limited or @@ -704,10 +704,10 @@ package Opt is -- Indicates the current setting of Fast_Math mode, as set by the use -- of a Fast_Math pragma (set True by Fast_Math (On)). - Force_ALI_Tree_File : Boolean := False; + Force_ALI_File : Boolean := False; -- GNAT - -- Force generation of ALI file even if errors are encountered. Also forces - -- generation of tree file if -gnatt is also set. Set on by use of -gnatQ. + -- Force generation of ALI file even if errors are encountered. + -- Set on by use of -gnatQ. Disable_ALI_File : Boolean := False; -- GNAT @@ -1644,10 +1644,6 @@ package Opt is -- Set True to treat pragma Restrictions as Restriction_Warnings. Set by -- -gnatr switch. - Tree_Output : Boolean := False; - -- GNAT - -- Set to True (-gnatt) to generate output tree file - Try_Semantics : Boolean := False; -- GNAT -- Flag set to force attempt at semantic analysis, even if parser errors @@ -2232,20 +2228,6 @@ package Opt is -- be in the spec of Expander, but it is referenced by Errout, and it -- really seems wrong for Errout to depend on Expander. - ----------------------- - -- Tree I/O Routines -- - ----------------------- - - procedure Tree_Read; - -- Reads switch settings from current tree file using Tree_Read - - procedure Tree_Write; - -- Writes out switch settings to current tree file using Tree_Write - - Tree_Version_String : String_Access; - -- Used to store the compiler version string read from a tree file to check - -- if it is from the same date as stored in the version string in Gnatvsn. - ----------------------------------- -- Modes for Formal Verification -- ----------------------------------- diff --git a/gcc/ada/osint-c.adb b/gcc/ada/osint-c.adb index a69cee2af2a..7708c1de9cb 100644 --- a/gcc/ada/osint-c.adb +++ b/gcc/ada/osint-c.adb @@ -23,8 +23,7 @@ -- -- ------------------------------------------------------------------------------ -with Opt; use Opt; -with Tree_IO; use Tree_IO; +with Opt; use Opt; package body Osint.C is @@ -490,69 +489,6 @@ package body Osint.C is Output_Object_File_Name := new String'(Name); end Set_Output_Object_File_Name; - ---------------- - -- Tree_Close -- - ---------------- - - procedure Tree_Close is - Status : Boolean; - begin - Tree_Write_Terminate; - Close (Output_FD, Status); - - if not Status then - Fail - ("error while closing tree file " - & Get_Name_String (Output_File_Name)); - end if; - end Tree_Close; - - ----------------- - -- Tree_Create -- - ----------------- - - procedure Tree_Create is - Dot_Index : Natural; - - begin - Get_Name_String (Current_Main); - - -- If an object file has been specified, then the ALI file - -- will be in the same directory as the object file; - -- so, we put the tree file in this same directory, - -- even though no object file needs to be generated. - - if Output_Object_File_Name /= null then - Name_Len := Output_Object_File_Name'Length; - Name_Buffer (1 .. Name_Len) := Output_Object_File_Name.all; - end if; - - Dot_Index := Name_Len + 1; - - for J in reverse 1 .. Name_Len loop - if Name_Buffer (J) = '.' then - Dot_Index := J; - exit; - end if; - end loop; - - -- Should be impossible to not have an extension - - pragma Assert (Dot_Index /= 0); - - -- Change extension to adt - - Name_Buffer (Dot_Index) := '.'; - Name_Buffer (Dot_Index + 1) := 'a'; - Name_Buffer (Dot_Index + 2) := 'd'; - Name_Buffer (Dot_Index + 3) := 't'; - Name_Buffer (Dot_Index + 4) := ASCII.NUL; - Name_Len := Dot_Index + 3; - Create_File_And_Check (Output_FD, Binary); - - Tree_Write_Initialize (Output_FD); - end Tree_Create; - ----------------------- -- Write_Debug_Info -- ----------------------- diff --git a/gcc/ada/osint-c.ads b/gcc/ada/osint-c.ads index 30637a54114..6862e30e258 100644 --- a/gcc/ada/osint-c.ads +++ b/gcc/ada/osint-c.ads @@ -197,16 +197,4 @@ package Osint.C is procedure Close_List_File; -- Close file previously opened by Create_List_File - -------------------------------- - -- Semantic Tree Input-Output -- - -------------------------------- - - procedure Tree_Create; - -- Creates the tree output file for the source file which is currently - -- being compiled (i.e. the file which was most recently returned by - -- Next_Main_Source), and initializes Tree_IO.Tree_Write for output. - - procedure Tree_Close; - -- Closes the file previously opened by Tree_Create - end Osint.C; diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index 22c78102619..84c0badd06f 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -64,8 +64,7 @@ package body Repinfo is --------------------------------------- -- A table internal to this unit is used to hold the values of back - -- annotated expressions. This table is written out by -gnatt and read - -- back in for ASIS processing. + -- annotated expressions. -- Node values are stored as Uint values using the negative of the node -- index in this table. Constants appear as non-negative Uint values. @@ -79,7 +78,7 @@ package body Repinfo is -- The following representation clause ensures that the above record -- has no holes. We do this so that when instances of this record are - -- written by Tree_Gen, we do not write uninitialized values to the file. + -- written, we do not write uninitialized values to the file. for Exp_Node use record Expr at 0 range 0 .. 31; @@ -2336,24 +2335,6 @@ package body Repinfo is end loop; end Spaces; - --------------- - -- Tree_Read -- - --------------- - - procedure Tree_Read is - begin - Rep_Table.Tree_Read; - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - procedure Tree_Write is - begin - Rep_Table.Tree_Write; - end Tree_Write; - --------------------- -- Write_Info_Line -- --------------------- diff --git a/gcc/ada/repinfo.ads b/gcc/ada/repinfo.ads index 5df9bd2af09..988bfc209df 100644 --- a/gcc/ada/repinfo.ads +++ b/gcc/ada/repinfo.ads @@ -388,10 +388,6 @@ package Repinfo is -- as an argument value, and return it unmodified. A No_Uint value is -- also returned unmodified. - procedure Tree_Read; - -- Initializes internal tables from current tree file using the relevant - -- Table.Tree_Read routines. - ------------------------ -- Compiler Interface -- ------------------------ @@ -400,10 +396,6 @@ package Repinfo is -- Procedure to list representation information. Bytes_Big_Endian is the -- value from Ttypes (Repinfo cannot have a dependency on Ttypes). - procedure Tree_Write; - -- Writes out internal tables to current tree file using the relevant - -- Table.Tree_Write routines. - -------------------------- -- Debugging Procedures -- -------------------------- diff --git a/gcc/ada/sem_aux.adb b/gcc/ada/sem_aux.adb index 44a0fcd9bd5..7da41a0ccec 100644 --- a/gcc/ada/sem_aux.adb +++ b/gcc/ada/sem_aux.adb @@ -1650,24 +1650,6 @@ package body Sem_Aux is return N; end Subprogram_Specification; - --------------- - -- Tree_Read -- - --------------- - - procedure Tree_Read is - begin - Obsolescent_Warnings.Tree_Read; - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - procedure Tree_Write is - begin - Obsolescent_Warnings.Tree_Write; - end Tree_Write; - -------------------- -- Ultimate_Alias -- -------------------- diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads index 8c647e84b8a..6f0d75e6d58 100644 --- a/gcc/ada/sem_aux.ads +++ b/gcc/ada/sem_aux.ads @@ -70,16 +70,7 @@ package Sem_Aux is procedure Initialize; -- Called at the start of compilation of each new main source file to - -- initialize the allocation of the Obsolescent_Warnings table. Note that - -- Initialize must not be called if Tree_Read is used. - - procedure Tree_Read; - -- Initializes Obsolescent_Warnings table from current tree file using the - -- relevant Table.Tree_Read routine. - - procedure Tree_Write; - -- Writes out Obsolescent_Warnings table to current tree file using the - -- relevant Table.Tree_Write routine. + -- initialize the allocation of the Obsolescent_Warnings table. ----------------- -- Subprograms -- diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index 0c51bbd8b7f..4c342d97a33 100644 --- a/gcc/ada/sinput.adb +++ b/gcc/ada/sinput.adb @@ -37,7 +37,6 @@ with Debug; use Debug; with Opt; use Opt; with Output; use Output; with Scans; use Scans; -with Tree_IO; use Tree_IO; with Widechar; use Widechar; with GNAT.Byte_Order_Mark; use GNAT.Byte_Order_Mark; @@ -1004,160 +1003,6 @@ package body Sinput is return Oldloc; end Top_Level_Location; - --------------- - -- Tree_Read -- - --------------- - - procedure Tree_Read is - begin - -- First we must free any old source buffer pointers - - for J in Source_File.First .. Source_File.Last loop - declare - S : Source_File_Record renames Source_File.Table (J); - begin - if S.Instance = No_Instance_Id then - Free_Source_Buffer (S.Source_Text); - - if S.Lines_Table /= null then - Memory.Free (To_Address (S.Lines_Table)); - S.Lines_Table := null; - end if; - - if S.Logical_Lines_Table /= null then - Memory.Free (To_Address (S.Logical_Lines_Table)); - S.Logical_Lines_Table := null; - end if; - - else - Free_Dope (S.Source_Text'Address); - S.Source_Text := null; - end if; - end; - end loop; - - -- Read in source file table and instance table - - Source_File.Tree_Read; - Instances.Tree_Read; - - -- The pointers we read in there for the source buffer and lines table - -- pointers are junk. We now read in the actual data that is referenced - -- by these two fields. - - for J in Source_File.First .. Source_File.Last loop - declare - S : Source_File_Record renames Source_File.Table (J); - begin - -- Normal case (non-instantiation) - - if S.Instance = No_Instance_Id then - S.Lines_Table := null; - S.Logical_Lines_Table := null; - Alloc_Line_Tables (S, Int (S.Last_Source_Line)); - - for J in 1 .. S.Last_Source_Line loop - Tree_Read_Int (Int (S.Lines_Table (J))); - end loop; - - if S.Num_SRef_Pragmas /= 0 then - for J in 1 .. S.Last_Source_Line loop - Tree_Read_Int (Int (S.Logical_Lines_Table (J))); - end loop; - end if; - - -- Allocate source buffer and read in the data - - declare - T : constant Source_Buffer_Ptr_Var := - new Source_Buffer (S.Source_First .. S.Source_Last); - begin - Tree_Read_Data (T (S.Source_First)'Address, - Int (S.Source_Last) - Int (S.Source_First) + 1); - S.Source_Text := T.all'Access; - end; - - -- For the instantiation case, we do not read in any data. Instead - -- we share the data for the generic template entry. Since the - -- template always occurs first, we can safely refer to its data. - - else - declare - ST : Source_File_Record renames - Source_File.Table (S.Template); - - begin - -- The lines tables are copied from the template entry - - S.Lines_Table := ST.Lines_Table; - S.Logical_Lines_Table := ST.Logical_Lines_Table; - - -- The Source_Text of the instance is the same data as that - -- of the template, but with different bounds. - - declare - Dope : constant Dope_Ptr := - new Dope_Rec'(S.Source_First, S.Source_Last); - begin - S.Source_Text := ST.Source_Text; - Set_Dope (S.Source_Text'Address, Dope); - end; - end; - end if; - end; - - Set_Source_File_Index_Table (J); - end loop; - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - procedure Tree_Write is - begin - Source_File.Tree_Write; - Instances.Tree_Write; - - -- The pointers we wrote out there for the source buffer and lines - -- table pointers are junk, we now write out the actual data that - -- is referenced by these two fields. - - for J in Source_File.First .. Source_File.Last loop - declare - S : Source_File_Record renames Source_File.Table (J); - - begin - -- For instantiations, there is nothing to do, since the data is - -- shared with the generic template. When the tree is read, the - -- pointers must be set, but no extra data needs to be written. - -- For the normal case, write out the data of the tables. - - if S.Instance = No_Instance_Id then - -- Lines table - - for J in 1 .. S.Last_Source_Line loop - Tree_Write_Int (Int (S.Lines_Table (J))); - end loop; - - -- Logical lines table if present - - if S.Num_SRef_Pragmas /= 0 then - for J in 1 .. S.Last_Source_Line loop - Tree_Write_Int (Int (S.Logical_Lines_Table (J))); - end loop; - end if; - - -- Source buffer - - Tree_Write_Data - (S.Source_Text (S.Source_First)'Address, - Int (S.Source_Last) - Int (S.Source_First) + 1); - end if; - end; - end loop; - end Tree_Write; - -------------------- -- Write_Location -- -------------------- diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads index 5eba40189f3..28c080dd5a0 100644 --- a/gcc/ada/sinput.ads +++ b/gcc/ada/sinput.ads @@ -715,14 +715,6 @@ package Sinput is procedure Write_Time_Stamp (S : Source_File_Index); -- Writes time stamp of specified file in YY-MM-DD HH:MM.SS format - procedure Tree_Read; - -- Initializes internal tables from current tree file using the relevant - -- Table.Tree_Read routines. - - procedure Tree_Write; - -- Writes out internal tables to current tree file using the relevant - -- Table.Tree_Write routines. - procedure Clear_Source_File_Table; -- This procedure frees memory allocated in the Source_File table (in the -- private). It should only be used when it is guaranteed that all source diff --git a/gcc/ada/stand.adb b/gcc/ada/stand.adb deleted file mode 100644 index cdc1d50c334..00000000000 --- a/gcc/ada/stand.adb +++ /dev/null @@ -1,190 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- S T A N D -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2020, 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- . -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Elists; use Elists; -with System; use System; -with Tree_IO; use Tree_IO; - -package body Stand is - - --------------- - -- Tree_Read -- - --------------- - - procedure Tree_Read is - begin - Tree_Read_Data (Standard_Entity'Address, - Standard_Entity_Array_Type'Size / Storage_Unit); - - Tree_Read_Int (Int (Standard_Package_Node)); - Tree_Read_Int (Int (Last_Standard_Node_Id)); - Tree_Read_Int (Int (Last_Standard_List_Id)); - - Tree_Read_Int (Int (Boolean_Literals (False))); - Tree_Read_Int (Int (Boolean_Literals (True))); - - Tree_Read_Int (Int (Standard_Void_Type)); - Tree_Read_Int (Int (Standard_Exception_Type)); - Tree_Read_Int (Int (Standard_A_String)); - Tree_Read_Int (Int (Standard_A_Char)); - Tree_Read_Int (Int (Standard_Debug_Renaming_Type)); - - -- Deal with Predefined_Float_Types, which is an Elist. We wrote the - -- entities out in sequence, terminated by an Empty entry. - - declare - Elmt : Entity_Id; - begin - Predefined_Float_Types := New_Elmt_List; - loop - Tree_Read_Int (Int (Elmt)); - exit when Elmt = Empty; - Append_Elmt (Elmt, Predefined_Float_Types); - end loop; - end; - - -- Remainder of special entities - - Tree_Read_Int (Int (Any_Id)); - Tree_Read_Int (Int (Any_Type)); - Tree_Read_Int (Int (Any_Access)); - Tree_Read_Int (Int (Any_Array)); - Tree_Read_Int (Int (Any_Boolean)); - Tree_Read_Int (Int (Any_Character)); - Tree_Read_Int (Int (Any_Composite)); - Tree_Read_Int (Int (Any_Discrete)); - Tree_Read_Int (Int (Any_Fixed)); - Tree_Read_Int (Int (Any_Integer)); - Tree_Read_Int (Int (Any_Modular)); - Tree_Read_Int (Int (Any_Numeric)); - Tree_Read_Int (Int (Any_Real)); - Tree_Read_Int (Int (Any_Scalar)); - Tree_Read_Int (Int (Any_String)); - Tree_Read_Int (Int (Raise_Type)); - Tree_Read_Int (Int (Universal_Integer)); - Tree_Read_Int (Int (Universal_Real)); - Tree_Read_Int (Int (Universal_Fixed)); - Tree_Read_Int (Int (Standard_Integer_8)); - Tree_Read_Int (Int (Standard_Integer_16)); - Tree_Read_Int (Int (Standard_Integer_32)); - Tree_Read_Int (Int (Standard_Integer_64)); - Tree_Read_Int (Int (Standard_Short_Short_Unsigned)); - Tree_Read_Int (Int (Standard_Short_Unsigned)); - Tree_Read_Int (Int (Standard_Unsigned)); - Tree_Read_Int (Int (Standard_Long_Unsigned)); - Tree_Read_Int (Int (Standard_Long_Long_Unsigned)); - Tree_Read_Int (Int (Standard_Unsigned_64)); - Tree_Read_Int (Int (Abort_Signal)); - Tree_Read_Int (Int (Standard_Op_Rotate_Left)); - Tree_Read_Int (Int (Standard_Op_Rotate_Right)); - Tree_Read_Int (Int (Standard_Op_Shift_Left)); - Tree_Read_Int (Int (Standard_Op_Shift_Right)); - Tree_Read_Int (Int (Standard_Op_Shift_Right_Arithmetic)); - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - procedure Tree_Write is - begin - Tree_Write_Data (Standard_Entity'Address, - Standard_Entity_Array_Type'Size / Storage_Unit); - - Tree_Write_Int (Int (Standard_Package_Node)); - Tree_Write_Int (Int (Last_Standard_Node_Id)); - Tree_Write_Int (Int (Last_Standard_List_Id)); - - Tree_Write_Int (Int (Boolean_Literals (False))); - Tree_Write_Int (Int (Boolean_Literals (True))); - - Tree_Write_Int (Int (Standard_Void_Type)); - Tree_Write_Int (Int (Standard_Exception_Type)); - Tree_Write_Int (Int (Standard_A_String)); - Tree_Write_Int (Int (Standard_A_Char)); - Tree_Write_Int (Int (Standard_Debug_Renaming_Type)); - - -- Deal with Predefined_Float_Types, which is an Elist. Write the - -- entities out in sequence, terminated by an Empty entry. - - declare - Elmt : Elmt_Id; - - begin - Elmt := First_Elmt (Predefined_Float_Types); - while Present (Elmt) loop - Tree_Write_Int (Int (Node (Elmt))); - Next_Elmt (Elmt); - end loop; - - Tree_Write_Int (Int (Empty)); - end; - - -- Remainder of special entries - - Tree_Write_Int (Int (Any_Id)); - Tree_Write_Int (Int (Any_Type)); - Tree_Write_Int (Int (Any_Access)); - Tree_Write_Int (Int (Any_Array)); - Tree_Write_Int (Int (Any_Boolean)); - Tree_Write_Int (Int (Any_Character)); - Tree_Write_Int (Int (Any_Composite)); - Tree_Write_Int (Int (Any_Discrete)); - Tree_Write_Int (Int (Any_Fixed)); - Tree_Write_Int (Int (Any_Integer)); - Tree_Write_Int (Int (Any_Modular)); - Tree_Write_Int (Int (Any_Numeric)); - Tree_Write_Int (Int (Any_Real)); - Tree_Write_Int (Int (Any_Scalar)); - Tree_Write_Int (Int (Any_String)); - Tree_Write_Int (Int (Raise_Type)); - Tree_Write_Int (Int (Universal_Integer)); - Tree_Write_Int (Int (Universal_Real)); - Tree_Write_Int (Int (Universal_Fixed)); - Tree_Write_Int (Int (Standard_Integer_8)); - Tree_Write_Int (Int (Standard_Integer_16)); - Tree_Write_Int (Int (Standard_Integer_32)); - Tree_Write_Int (Int (Standard_Integer_64)); - Tree_Write_Int (Int (Standard_Short_Short_Unsigned)); - Tree_Write_Int (Int (Standard_Short_Unsigned)); - Tree_Write_Int (Int (Standard_Unsigned)); - Tree_Write_Int (Int (Standard_Long_Unsigned)); - Tree_Write_Int (Int (Standard_Long_Long_Unsigned)); - Tree_Write_Int (Int (Standard_Unsigned_64)); - Tree_Write_Int (Int (Abort_Signal)); - Tree_Write_Int (Int (Standard_Op_Rotate_Left)); - Tree_Write_Int (Int (Standard_Op_Rotate_Right)); - Tree_Write_Int (Int (Standard_Op_Shift_Left)); - Tree_Write_Int (Int (Standard_Op_Shift_Right)); - Tree_Write_Int (Int (Standard_Op_Shift_Right_Arithmetic)); - end Tree_Write; - -end Stand; diff --git a/gcc/ada/stand.ads b/gcc/ada/stand.ads index 49676918176..43b876ab379 100644 --- a/gcc/ada/stand.ads +++ b/gcc/ada/stand.ads @@ -480,17 +480,4 @@ package Stand is Standard_Op_Shift_Right_Arithmetic : Entity_Id; -- These entities are used for shift operators generated by the expander - ----------------- - -- Subprograms -- - ----------------- - - procedure Tree_Read; - -- Initializes entity values in this package from the current tree file - -- using Tree_IO. Note that Tree_Read includes all the initialization that - -- is carried out by Create_Standard. - - procedure Tree_Write; - -- Writes out the entity values in this package to the current tree file - -- using Tree_IO. - end Stand; diff --git a/gcc/ada/stringt.adb b/gcc/ada/stringt.adb index 14ad53b6a05..35e9028aef8 100644 --- a/gcc/ada/stringt.adb +++ b/gcc/ada/stringt.adb @@ -360,26 +360,6 @@ package body Stringt is return To_String (Buf); end To_String; - --------------- - -- Tree_Read -- - --------------- - - procedure Tree_Read is - begin - String_Chars.Tree_Read; - Strings.Tree_Read; - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - procedure Tree_Write is - begin - String_Chars.Tree_Write; - Strings.Tree_Write; - end Tree_Write; - ------------ -- Unlock -- ------------ diff --git a/gcc/ada/stringt.ads b/gcc/ada/stringt.ads index 15c7e35b796..52f5fd74210 100644 --- a/gcc/ada/stringt.ads +++ b/gcc/ada/stringt.ads @@ -62,8 +62,7 @@ package Stringt is -------------------------------------- procedure Initialize; - -- Initializes the strings table for a new compilation. Note that - -- Initialize must not be called if Tree_Read is used. + -- Initializes the strings table for a new compilation. procedure Lock; -- Lock internal tables before calling back end @@ -148,15 +147,6 @@ package Stringt is function Strings_Address return System.Address; -- Return address of Strings table (used by Back_End call to Gigi) - procedure Tree_Read; - -- Initializes internal tables from current tree file using the relevant - -- Table.Tree_Read routines. Note that Initialize should not be called if - -- Tree_Read is used. Tree_Read includes all necessary initialization. - - procedure Tree_Write; - -- Writes out internal tables to current tree file using the relevant - -- Table.Tree_Write routines. - procedure Write_Char_Code (Code : Char_Code); -- Procedure to write a character code value, used for debugging purposes -- for writing character codes. If the character code is in the range diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 319188b3d75..c5f2e1cc959 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -1170,7 +1170,7 @@ package body Switch.C is when 'Q' => Ptr := Ptr + 1; - Force_ALI_Tree_File := True; + Force_ALI_File := True; Try_Semantics := True; -- -gnatr (restrictions as warnings) diff --git a/gcc/ada/table.adb b/gcc/ada/table.adb index 079e035a933..cd7cbefe14e 100644 --- a/gcc/ada/table.adb +++ b/gcc/ada/table.adb @@ -33,7 +33,6 @@ with Debug; use Debug; with Opt; use Opt; with Output; use Output; with System; use System; -with Tree_IO; use Tree_IO; with System.Memory; use System.Memory; @@ -60,10 +59,6 @@ package body Table is -- in Max. Works correctly to do an initial allocation if the table -- is currently null. - function Tree_Get_Table_Address return Address; - -- Return Null_Address if the table length is zero, - -- Table (First)'Address if not. - pragma Warnings (Off); -- Turn off warnings. The following unchecked conversions are only used -- internally in this package, and cannot never result in any instances @@ -400,60 +395,6 @@ package body Table is end if; end Set_Last; - ---------------------------- - -- Tree_Get_Table_Address -- - ---------------------------- - - function Tree_Get_Table_Address return Address is - begin - if Length = 0 then - return Null_Address; - else - return Table (First)'Address; - end if; - end Tree_Get_Table_Address; - - --------------- - -- Tree_Read -- - --------------- - - -- Note: we allocate only the space required to accommodate the data - -- actually written, which means that a Tree_Write/Tree_Read sequence - -- does an implicit Release. - - procedure Tree_Read is - begin - Tree_Read_Int (Max); - Last_Val := Max; - Length := Max - Min + 1; - Reallocate; - - Tree_Read_Data - (Tree_Get_Table_Address, - (Last_Val - Int (First) + 1) * - - -- Note the importance of parenthesizing the following division - -- to avoid the possibility of intermediate overflow. - - (Table_Type'Component_Size / Storage_Unit)); - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - -- Note: we write out only the currently valid data, not the entire - -- contents of the allocated array. See note above on Tree_Read. - - procedure Tree_Write is - begin - Tree_Write_Int (Int (Last)); - Tree_Write_Data - (Tree_Get_Table_Address, - (Last_Val - Int (First) + 1) * - (Table_Type'Component_Size / Storage_Unit)); - end Tree_Write; - begin Init; end Table; diff --git a/gcc/ada/table.ads b/gcc/ada/table.ads index 352f7513722..e8cbe81ff14 100644 --- a/gcc/ada/table.ads +++ b/gcc/ada/table.ads @@ -221,13 +221,6 @@ package Table is -- Given a Saved_Table value returned by a prior call to Save, restores -- the table to the state it was in at the time of the Save call. - procedure Tree_Write; - -- Writes out contents of table using Tree_IO - - procedure Tree_Read; - -- Initializes table by reading contents previously written with the - -- Tree_Write call (also using Tree_IO). - private Last_Val : Int; diff --git a/gcc/ada/tree_gen.adb b/gcc/ada/tree_gen.adb deleted file mode 100644 index 109b0157f68..00000000000 --- a/gcc/ada/tree_gen.adb +++ /dev/null @@ -1,72 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- T R E E _ G E N -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2020, 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. -- --- -- ------------------------------------------------------------------------------- - -with Aspects; -with Atree; -with Elists; -with Fname; -with Lib; -with Namet; -with Nlists; -with Opt; -with Osint.C; -with Repinfo; -with Sem_Aux; -with Sinput; -with Stand; -with Stringt; -with Uintp; -with Urealp; - -with Tree_In; -pragma Warnings (Off, Tree_In); --- We do not use Tree_In in the compiler, but it is small, and worth including --- so that we get the proper license check for Tree_In when the compiler is --- built. This will avoid adding bad dependencies to Tree_In and blowing ASIS. - -procedure Tree_Gen is -begin - if Opt.Tree_Output then - Osint.C.Tree_Create; - - Opt.Tree_Write; - Atree.Tree_Write; - Elists.Tree_Write; - Fname.Tree_Write; - Lib.Tree_Write; - Namet.Tree_Write; - Nlists.Tree_Write; - Sem_Aux.Tree_Write; - Sinput.Tree_Write; - Stand.Tree_Write; - Stringt.Tree_Write; - Uintp.Tree_Write; - Urealp.Tree_Write; - Repinfo.Tree_Write; - Aspects.Tree_Write; - - Osint.C.Tree_Close; - end if; -end Tree_Gen; diff --git a/gcc/ada/tree_gen.ads b/gcc/ada/tree_gen.ads deleted file mode 100644 index f1c57c35219..00000000000 --- a/gcc/ada/tree_gen.ads +++ /dev/null @@ -1,28 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- T R E E _ G E N -- --- -- --- S p e c -- --- -- --- Copyright (C) 1992-2020, 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. -- --- -- ------------------------------------------------------------------------------- - --- This procedure is used to write out the tree if the option is set - -procedure Tree_Gen; diff --git a/gcc/ada/tree_in.adb b/gcc/ada/tree_in.adb deleted file mode 100644 index c02c1770a0d..00000000000 --- a/gcc/ada/tree_in.adb +++ /dev/null @@ -1,71 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- T R E E _ I N -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2020, 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- . -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Aspects; -with Atree; -with Csets; -with Elists; -with Fname; -with Lib; -with Namet; -with Nlists; -with Opt; -with Repinfo; -with Sem_Aux; -with Sinput; -with Stand; -with Stringt; -with Tree_IO; -with Uintp; -with Urealp; - -procedure Tree_In (Desc : File_Descriptor) is -begin - Tree_IO.Tree_Read_Initialize (Desc); - - Opt.Tree_Read; - Atree.Tree_Read; - Elists.Tree_Read; - Fname.Tree_Read; - Lib.Tree_Read; - Namet.Tree_Read; - Nlists.Tree_Read; - Sem_Aux.Tree_Read; - Sinput.Tree_Read; - Stand.Tree_Read; - Stringt.Tree_Read; - Uintp.Tree_Read; - Urealp.Tree_Read; - Repinfo.Tree_Read; - Aspects.Tree_Read; - - Csets.Initialize; -end Tree_In; diff --git a/gcc/ada/tree_in.ads b/gcc/ada/tree_in.ads deleted file mode 100644 index 32fbe7c0ce1..00000000000 --- a/gcc/ada/tree_in.ads +++ /dev/null @@ -1,42 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- T R E E _ I N -- --- -- --- S p e c -- --- -- --- Copyright (C) 1992-2020, 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- . -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This procedure is used to read in a tree if the option is set. Note that --- it is not part of the compiler proper, but rather the interface from --- tools that need to read the tree to the tree reading routines, and is --- thus bound as part of such tools. - -with System.OS_Lib; use System.OS_Lib; - -procedure Tree_In (Desc : File_Descriptor); --- Desc is the file descriptor for the file containing the tree, as written --- by the compiler in a previous compilation using Tree_Gen. On return the --- global data structures are appropriately initialized. diff --git a/gcc/ada/tree_io.adb b/gcc/ada/tree_io.adb deleted file mode 100644 index a4ee3938697..00000000000 --- a/gcc/ada/tree_io.adb +++ /dev/null @@ -1,661 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- T R E E _ I O -- --- -- --- B o d y -- --- -- --- Copyright (C) 1992-2020, 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- . -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -with Debug; use Debug; -with Output; use Output; -with Unchecked_Conversion; - -package body Tree_IO is - Debug_Flag_Tree : Boolean := False; - -- Debug flag for debug output from tree read/write - - ------------------------------------------- - -- Compression Scheme Used for Tree File -- - ------------------------------------------- - - -- We don't just write the data directly, but instead do a mild form - -- of compression, since we expect lots of compressible zeroes and - -- blanks. The compression scheme is as follows: - - -- 00nnnnnn followed by nnnnnn bytes (non compressed data) - -- 01nnnnnn indicates nnnnnn binary zero bytes - -- 10nnnnnn indicates nnnnnn ASCII space bytes - -- 11nnnnnn bbbbbbbb indicates nnnnnnnn occurrences of byte bbbbbbbb - - -- Since we expect many zeroes in trees, and many spaces in sources, - -- this compression should be reasonably efficient. We can put in - -- something better later on. - - -- Note that this compression applies to the Write_Tree_Data and - -- Read_Tree_Data calls, not to the calls to read and write single - -- scalar values, which are written in memory format without any - -- compression. - - C_Noncomp : constant := 2#00_000000#; - C_Zeros : constant := 2#01_000000#; - C_Spaces : constant := 2#10_000000#; - C_Repeat : constant := 2#11_000000#; - -- Codes for compression sequences - - Max_Count : constant := 63; - -- Maximum data length for one compression sequence - - -- The above compression scheme applies only to data written with the - -- Tree_Write routine and read with Tree_Read. Data written using the - -- Tree_Write_Char or Tree_Write_Int routines and read using the - -- corresponding input routines is not compressed. - - type Int_Bytes is array (1 .. 4) of Byte; - for Int_Bytes'Size use 32; - - function To_Int_Bytes is new Unchecked_Conversion (Int, Int_Bytes); - function To_Int is new Unchecked_Conversion (Int_Bytes, Int); - - ---------------------- - -- Global Variables -- - ---------------------- - - Tree_FD : File_Descriptor; - -- File descriptor for tree - - Buflen : constant Int := 8_192; - -- Length of buffer for read and write file data - - Buf : array (Pos range 1 .. Buflen) of Byte; - -- Read/write file data buffer - - Bufn : Nat; - -- Number of bytes read/written from/to buffer - - Buft : Nat; - -- Total number of bytes in input buffer containing valid data. Used only - -- for input operations. There is data left to be processed in the buffer - -- if Buft > Bufn. A value of zero for Buft means that the buffer is empty. - - ----------------------- - -- Local Subprograms -- - ----------------------- - - procedure Read_Buffer; - -- Reads data into buffer, setting Bufn appropriately - - function Read_Byte return Byte; - pragma Inline (Read_Byte); - -- Returns next byte from input file, raises Tree_Format_Error if none left - - procedure Write_Buffer; - -- Writes out current buffer contents - - procedure Write_Byte (B : Byte); - pragma Inline (Write_Byte); - -- Write one byte to output buffer, checking for buffer-full condition - - ----------------- - -- Read_Buffer -- - ----------------- - - procedure Read_Buffer is - begin - Buft := Int (Read (Tree_FD, Buf (1)'Address, Integer (Buflen))); - - if Buft = 0 then - raise Tree_Format_Error; - else - Bufn := 0; - end if; - end Read_Buffer; - - --------------- - -- Read_Byte -- - --------------- - - function Read_Byte return Byte is - begin - if Bufn = Buft then - Read_Buffer; - end if; - - Bufn := Bufn + 1; - return Buf (Bufn); - end Read_Byte; - - -------------------- - -- Tree_Read_Bool -- - -------------------- - - procedure Tree_Read_Bool (B : out Boolean) is - begin - B := Boolean'Val (Read_Byte); - - if Debug_Flag_Tree then - if B then - Write_Str ("True"); - else - Write_Str ("False"); - end if; - - Write_Eol; - end if; - end Tree_Read_Bool; - - -------------------- - -- Tree_Read_Char -- - -------------------- - - procedure Tree_Read_Char (C : out Character) is - begin - C := Character'Val (Read_Byte); - - if Debug_Flag_Tree then - Write_Str ("==> transmitting Character = "); - Write_Char (C); - Write_Eol; - end if; - end Tree_Read_Char; - - -------------------- - -- Tree_Read_Data -- - -------------------- - - procedure Tree_Read_Data (Addr : Address; Length : Int) is - - type S is array (Pos) of Byte; - -- This is a big array, for which we have to suppress the warning - - type SP is access all S; - - function To_SP is new Unchecked_Conversion (Address, SP); - - Data : constant SP := To_SP (Addr); - -- Data buffer to be read as an indexable array of bytes - - OP : Pos := 1; - -- Pointer to next byte of data buffer to be read into - - B : Byte; - C : Byte; - L : Int; - - begin - if Debug_Flag_Tree then - Write_Str ("==> transmitting "); - Write_Int (Length); - Write_Str (" data bytes"); - Write_Eol; - end if; - - -- Verify data length - - Tree_Read_Int (L); - - if L /= Length then - Write_Str ("==> transmitting, expected "); - Write_Int (Length); - Write_Str (" bytes, found length = "); - Write_Int (L); - Write_Eol; - raise Tree_Format_Error; - end if; - - -- Loop to read data - - while OP <= Length loop - - -- Get compression control character - - B := Read_Byte; - C := B and 2#00_111111#; - B := B and 2#11_000000#; - - -- Non-repeat case - - if B = C_Noncomp then - if Debug_Flag_Tree then - Write_Str ("==> uncompressed: "); - Write_Int (Int (C)); - Write_Str (", starting at "); - Write_Int (OP); - Write_Eol; - end if; - - for J in 1 .. C loop - Data (OP) := Read_Byte; - OP := OP + 1; - end loop; - - -- Repeated zeroes - - elsif B = C_Zeros then - if Debug_Flag_Tree then - Write_Str ("==> zeroes: "); - Write_Int (Int (C)); - Write_Str (", starting at "); - Write_Int (OP); - Write_Eol; - end if; - - for J in 1 .. C loop - Data (OP) := 0; - OP := OP + 1; - end loop; - - -- Repeated spaces - - elsif B = C_Spaces then - if Debug_Flag_Tree then - Write_Str ("==> spaces: "); - Write_Int (Int (C)); - Write_Str (", starting at "); - Write_Int (OP); - Write_Eol; - end if; - - for J in 1 .. C loop - Data (OP) := Character'Pos (' '); - OP := OP + 1; - end loop; - - -- Specified repeated character - - else -- B = C_Repeat - B := Read_Byte; - - if Debug_Flag_Tree then - Write_Str ("==> other char: "); - Write_Int (Int (C)); - Write_Str (" ("); - Write_Int (Int (B)); - Write_Char (')'); - Write_Str (", starting at "); - Write_Int (OP); - Write_Eol; - end if; - - for J in 1 .. C loop - Data (OP) := B; - OP := OP + 1; - end loop; - end if; - end loop; - - -- At end of loop, data item must be exactly filled - - if OP /= Length + 1 then - raise Tree_Format_Error; - end if; - - end Tree_Read_Data; - - -------------------------- - -- Tree_Read_Initialize -- - -------------------------- - - procedure Tree_Read_Initialize (Desc : File_Descriptor) is - begin - Buft := 0; - Bufn := 0; - Tree_FD := Desc; - Debug_Flag_Tree := Debug_Flag_5; - end Tree_Read_Initialize; - - ------------------- - -- Tree_Read_Int -- - ------------------- - - procedure Tree_Read_Int (N : out Int) is - N_Bytes : Int_Bytes; - - begin - for J in 1 .. 4 loop - N_Bytes (J) := Read_Byte; - end loop; - - N := To_Int (N_Bytes); - - if Debug_Flag_Tree then - Write_Str ("==> transmitting Int = "); - Write_Int (N); - Write_Eol; - end if; - end Tree_Read_Int; - - ------------------- - -- Tree_Read_Str -- - ------------------- - - procedure Tree_Read_Str (S : out String_Ptr) is - N : Nat; - - begin - Tree_Read_Int (N); - S := new String (1 .. Natural (N)); - Tree_Read_Data (S.all (1)'Address, N); - end Tree_Read_Str; - - ------------------------- - -- Tree_Read_Terminate -- - ------------------------- - - procedure Tree_Read_Terminate is - begin - -- Must be at end of input buffer, so we should get Tree_Format_Error - -- if we try to read one more byte, if not, we have a format error. - - declare - B : Byte; - pragma Warnings (Off, B); - - begin - B := Read_Byte; - - exception - when Tree_Format_Error => return; - end; - - raise Tree_Format_Error; - end Tree_Read_Terminate; - - --------------------- - -- Tree_Write_Bool -- - --------------------- - - procedure Tree_Write_Bool (B : Boolean) is - begin - if Debug_Flag_Tree then - Write_Str ("==> transmitting Boolean = "); - - if B then - Write_Str ("True"); - else - Write_Str ("False"); - end if; - - Write_Eol; - end if; - - Write_Byte (Boolean'Pos (B)); - end Tree_Write_Bool; - - --------------------- - -- Tree_Write_Char -- - --------------------- - - procedure Tree_Write_Char (C : Character) is - begin - if Debug_Flag_Tree then - Write_Str ("==> transmitting Character = "); - Write_Char (C); - Write_Eol; - end if; - - Write_Byte (Character'Pos (C)); - end Tree_Write_Char; - - --------------------- - -- Tree_Write_Data -- - --------------------- - - procedure Tree_Write_Data (Addr : Address; Length : Int) is - - type S is array (Pos) of Byte; - -- This is a big array, for which we have to suppress the warning - - type SP is access all S; - - function To_SP is new Unchecked_Conversion (Address, SP); - - Data : constant SP := To_SP (Addr); - -- Pointer to data to be written, converted to array type - - IP : Pos := 1; - -- Input buffer pointer, next byte to be processed - - NC : Nat range 0 .. Max_Count := 0; - -- Number of bytes of non-compressible sequence - - C : Byte; - - procedure Write_Non_Compressed_Sequence; - -- Output currently collected sequence of non-compressible data - - ----------------------------------- - -- Write_Non_Compressed_Sequence -- - ----------------------------------- - - procedure Write_Non_Compressed_Sequence is - begin - if NC > 0 then - Write_Byte (C_Noncomp + Byte (NC)); - - if Debug_Flag_Tree then - Write_Str ("==> uncompressed: "); - Write_Int (NC); - Write_Str (", starting at "); - Write_Int (IP - NC); - Write_Eol; - end if; - - for J in reverse 1 .. NC loop - Write_Byte (Data (IP - J)); - end loop; - - NC := 0; - end if; - end Write_Non_Compressed_Sequence; - - -- Start of processing for Tree_Write_Data - - begin - if Debug_Flag_Tree then - Write_Str ("==> transmitting "); - Write_Int (Length); - Write_Str (" data bytes"); - Write_Eol; - end if; - - -- We write the count at the start, so that we can check it on - -- the corresponding read to make sure that reads and writes match - - Tree_Write_Int (Length); - - -- Conversion loop - -- IP is index of next input character - -- NC is number of non-compressible bytes saved up - - loop - -- If input is completely processed, then we are all done - - if IP > Length then - Write_Non_Compressed_Sequence; - return; - end if; - - -- Test for compressible sequence, must be at least three identical - -- bytes in a row to be worthwhile compressing. - - if IP + 2 <= Length - and then Data (IP) = Data (IP + 1) - and then Data (IP) = Data (IP + 2) - then - Write_Non_Compressed_Sequence; - - -- Count length of new compression sequence - - C := 3; - IP := IP + 3; - - while IP < Length - and then Data (IP) = Data (IP - 1) - and then C < Max_Count - loop - C := C + 1; - IP := IP + 1; - end loop; - - -- Output compression sequence - - if Data (IP - 1) = 0 then - if Debug_Flag_Tree then - Write_Str ("==> zeroes: "); - Write_Int (Int (C)); - Write_Str (", starting at "); - Write_Int (IP - Int (C)); - Write_Eol; - end if; - - Write_Byte (C_Zeros + C); - - elsif Data (IP - 1) = Character'Pos (' ') then - if Debug_Flag_Tree then - Write_Str ("==> spaces: "); - Write_Int (Int (C)); - Write_Str (", starting at "); - Write_Int (IP - Int (C)); - Write_Eol; - end if; - - Write_Byte (C_Spaces + C); - - else - if Debug_Flag_Tree then - Write_Str ("==> other char: "); - Write_Int (Int (C)); - Write_Str (" ("); - Write_Int (Int (Data (IP - 1))); - Write_Char (')'); - Write_Str (", starting at "); - Write_Int (IP - Int (C)); - Write_Eol; - end if; - - Write_Byte (C_Repeat + C); - Write_Byte (Data (IP - 1)); - end if; - - -- No compression possible here - - else - -- Output non-compressed sequence if at maximum length - - if NC = Max_Count then - Write_Non_Compressed_Sequence; - end if; - - NC := NC + 1; - IP := IP + 1; - end if; - end loop; - - end Tree_Write_Data; - - --------------------------- - -- Tree_Write_Initialize -- - --------------------------- - - procedure Tree_Write_Initialize (Desc : File_Descriptor) is - begin - Bufn := 0; - Tree_FD := Desc; - Set_Standard_Error; - Debug_Flag_Tree := Debug_Flag_5; - end Tree_Write_Initialize; - - -------------------- - -- Tree_Write_Int -- - -------------------- - - procedure Tree_Write_Int (N : Int) is - N_Bytes : constant Int_Bytes := To_Int_Bytes (N); - - begin - if Debug_Flag_Tree then - Write_Str ("==> transmitting Int = "); - Write_Int (N); - Write_Eol; - end if; - - for J in 1 .. 4 loop - Write_Byte (N_Bytes (J)); - end loop; - end Tree_Write_Int; - - -------------------- - -- Tree_Write_Str -- - -------------------- - - procedure Tree_Write_Str (S : String_Ptr) is - begin - Tree_Write_Int (S'Length); - Tree_Write_Data (S (1)'Address, S'Length); - end Tree_Write_Str; - - -------------------------- - -- Tree_Write_Terminate -- - -------------------------- - - procedure Tree_Write_Terminate is - begin - if Bufn > 0 then - Write_Buffer; - end if; - end Tree_Write_Terminate; - - ------------------ - -- Write_Buffer -- - ------------------ - - procedure Write_Buffer is - begin - if Integer (Bufn) = Write (Tree_FD, Buf'Address, Integer (Bufn)) then - Bufn := 0; - - else - Set_Standard_Error; - Write_Str ("fatal error: disk full"); - OS_Exit (2); - end if; - end Write_Buffer; - - ---------------- - -- Write_Byte -- - ---------------- - - procedure Write_Byte (B : Byte) is - begin - Bufn := Bufn + 1; - Buf (Bufn) := B; - - if Bufn = Buflen then - Write_Buffer; - end if; - end Write_Byte; - -end Tree_IO; diff --git a/gcc/ada/tree_io.ads b/gcc/ada/tree_io.ads deleted file mode 100644 index fb7fbc5a54e..00000000000 --- a/gcc/ada/tree_io.ads +++ /dev/null @@ -1,109 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT COMPILER COMPONENTS -- --- -- --- T R E E _ I O -- --- -- --- S p e c -- --- -- --- Copyright (C) 1992-2020, 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. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- . -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- This package contains the routines used to read and write the tree files --- used by ASIS. Only the actual read and write routines are here. The open, --- create and close routines are elsewhere (in Osint in the compiler, and in --- the tree read driver for the tree read interface). - --- Should we remove this package altogether??? - -with Types; use Types; -with System; use System; - -pragma Warnings (Off); --- This package is used also by gnatcoll -with System.OS_Lib; use System.OS_Lib; -pragma Warnings (On); - -package Tree_IO is - - Tree_Format_Error : exception; - -- Raised if a format error is detected in the input file - - procedure Tree_Read_Initialize (Desc : File_Descriptor); - -- Called to initialize reading of a tree file. This call must be made - -- before calls to Tree_Read_xx. No calls to Tree_Write_xx are permitted - -- after this call. - - procedure Tree_Read_Data (Addr : Address; Length : Int); - -- Checks that the Length provided is the same as what has been provided - -- to the corresponding Tree_Write_Data from the current tree file, - -- Tree_Format_Error is raised if it is not the case. If Length is - -- correct and non zero, reads Length bytes of information into memory - -- starting at Addr from the current tree file. - - procedure Tree_Read_Bool (B : out Boolean); - -- Reads a single boolean value. The boolean value must have been written - -- with a call to the Tree_Write_Bool procedure. - - procedure Tree_Read_Char (C : out Character); - -- Reads a single character. The character must have been written with a - -- call to the Tree_Write_Char procedure. - - procedure Tree_Read_Int (N : out Int); - -- Reads a single integer value. The integer must have been written with - -- a call to the Tree_Write_Int procedure. - - procedure Tree_Read_Str (S : out String_Ptr); - -- Read string, allocate on heap, and return pointer to allocated string - -- which always has a lower bound of 1. - - procedure Tree_Read_Terminate; - -- Called after reading all data, checks that the buffer pointers is at - -- the end of file, raising Tree_Format_Error if not. - - procedure Tree_Write_Initialize (Desc : File_Descriptor); - -- Called to initialize writing of a tree file. This call must be made - -- before calls to Tree_Write_xx. No calls to Tree_Read_xx are permitted - -- after this call. - - procedure Tree_Write_Data (Addr : Address; Length : Int); - -- Writes Length then, if Length is not null, Length bytes of data - -- starting at Addr to current tree file - - procedure Tree_Write_Bool (B : Boolean); - -- Writes a single boolean value to the current tree file - - procedure Tree_Write_Char (C : Character); - -- Writes a single character to the current tree file - - procedure Tree_Write_Int (N : Int); - -- Writes a single integer value to the current tree file - - procedure Tree_Write_Str (S : String_Ptr); - -- Write out string value referenced by S (low bound of S must be 1) - - procedure Tree_Write_Terminate; - -- Terminates writing of the file (flushing the buffer), but does not - -- close the file (the caller is responsible for closing the file). - -end Tree_IO; diff --git a/gcc/ada/uintp.adb b/gcc/ada/uintp.adb index a083cebe503..5f479b4e754 100644 --- a/gcc/ada/uintp.adb +++ b/gcc/ada/uintp.adb @@ -29,8 +29,7 @@ -- -- ------------------------------------------------------------------------------ -with Output; use Output; -with Tree_IO; use Tree_IO; +with Output; use Output; with GNAT.HTable; use GNAT.HTable; @@ -716,58 +715,6 @@ package body Uintp is end if; end Release_And_Save; - --------------- - -- Tree_Read -- - --------------- - - procedure Tree_Read is - begin - Uints.Tree_Read; - Udigits.Tree_Read; - - Tree_Read_Int (Int (Uint_Int_First)); - Tree_Read_Int (Int (Uint_Int_Last)); - Tree_Read_Int (UI_Power_2_Set); - Tree_Read_Int (UI_Power_10_Set); - Tree_Read_Int (Int (Uints_Min)); - Tree_Read_Int (Udigits_Min); - - for J in 0 .. UI_Power_2_Set loop - Tree_Read_Int (Int (UI_Power_2 (J))); - end loop; - - for J in 0 .. UI_Power_10_Set loop - Tree_Read_Int (Int (UI_Power_10 (J))); - end loop; - - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - procedure Tree_Write is - begin - Uints.Tree_Write; - Udigits.Tree_Write; - - Tree_Write_Int (Int (Uint_Int_First)); - Tree_Write_Int (Int (Uint_Int_Last)); - Tree_Write_Int (UI_Power_2_Set); - Tree_Write_Int (UI_Power_10_Set); - Tree_Write_Int (Int (Uints_Min)); - Tree_Write_Int (Udigits_Min); - - for J in 0 .. UI_Power_2_Set loop - Tree_Write_Int (Int (UI_Power_2 (J))); - end loop; - - for J in 0 .. UI_Power_10_Set loop - Tree_Write_Int (Int (UI_Power_10 (J))); - end loop; - - end Tree_Write; - ------------- -- UI_Abs -- ------------- diff --git a/gcc/ada/uintp.ads b/gcc/ada/uintp.ads index b0fa9948631..652145e1bfa 100644 --- a/gcc/ada/uintp.ads +++ b/gcc/ada/uintp.ads @@ -107,20 +107,10 @@ package Uintp is ----------------- procedure Initialize; - -- Initialize Uint tables. Note that Initialize must not be called if - -- Tree_Read is used. Note also that there is no lock routine in this + -- Initialize Uint tables. Note also that there is no lock routine in this -- unit, these are among the few tables that can be expanded during -- gigi processing. - procedure Tree_Read; - -- Initializes internal tables from current tree file using the relevant - -- Table.Tree_Read routines. Note that Initialize should not be called if - -- Tree_Read is used. Tree_Read includes all necessary initialization. - - procedure Tree_Write; - -- Writes out internal tables to current tree file using the relevant - -- Table.Tree_Write routines. - function UI_Abs (Right : Uint) return Uint; pragma Inline (UI_Abs); -- Returns abs function of universal integer diff --git a/gcc/ada/urealp.adb b/gcc/ada/urealp.adb index f320e8301d9..cd45cc0f77b 100644 --- a/gcc/ada/urealp.adb +++ b/gcc/ada/urealp.adb @@ -30,9 +30,8 @@ ------------------------------------------------------------------------------ with Alloc; -with Output; use Output; +with Output; use Output; with Table; -with Tree_IO; use Tree_IO; package body Urealp is @@ -57,7 +56,7 @@ package body Urealp is -- The following representation clause ensures that the above record -- has no holes. We do this so that when instances of this record are - -- written by Tree_Gen, we do not write uninitialized values to the file. + -- written, we do not write uninitialized values to the file. for Ureal_Entry use record Num at 0 range 0 .. 31; @@ -95,10 +94,6 @@ package body Urealp is UR_2_M_128 : Ureal; UR_2_M_80 : Ureal; - Num_Ureal_Constants : constant := 10; - -- This is used for an assertion check in Tree_Read and Tree_Write to - -- help remember to add values to these routines when we add to the list. - Normalized_Real : Ureal := No_Ureal; -- Used to memoize Norm_Num and Norm_Den, if either of these functions -- is called, this value is set and Normalized_Entry contains the result @@ -487,52 +482,6 @@ package body Urealp is return Store_Ureal (Normalize (Val)); end Store_Ureal_Normalized; - --------------- - -- Tree_Read -- - --------------- - - procedure Tree_Read is - begin - pragma Assert (Num_Ureal_Constants = 10); - - Ureals.Tree_Read; - Tree_Read_Int (Int (UR_0)); - Tree_Read_Int (Int (UR_M_0)); - Tree_Read_Int (Int (UR_Tenth)); - Tree_Read_Int (Int (UR_Half)); - Tree_Read_Int (Int (UR_1)); - Tree_Read_Int (Int (UR_2)); - Tree_Read_Int (Int (UR_10)); - Tree_Read_Int (Int (UR_100)); - Tree_Read_Int (Int (UR_2_128)); - Tree_Read_Int (Int (UR_2_M_128)); - - -- Clear the normalization cache - - Normalized_Real := No_Ureal; - end Tree_Read; - - ---------------- - -- Tree_Write -- - ---------------- - - procedure Tree_Write is - begin - pragma Assert (Num_Ureal_Constants = 10); - - Ureals.Tree_Write; - Tree_Write_Int (Int (UR_0)); - Tree_Write_Int (Int (UR_M_0)); - Tree_Write_Int (Int (UR_Tenth)); - Tree_Write_Int (Int (UR_Half)); - Tree_Write_Int (Int (UR_1)); - Tree_Write_Int (Int (UR_2)); - Tree_Write_Int (Int (UR_10)); - Tree_Write_Int (Int (UR_100)); - Tree_Write_Int (Int (UR_2_128)); - Tree_Write_Int (Int (UR_2_M_128)); - end Tree_Write; - ------------ -- UR_Abs -- ------------ diff --git a/gcc/ada/urealp.ads b/gcc/ada/urealp.ads index 3312f1dbc98..394bfed072b 100644 --- a/gcc/ada/urealp.ads +++ b/gcc/ada/urealp.ads @@ -135,20 +135,10 @@ package Urealp is ----------------- procedure Initialize; - -- Initialize Ureal tables. Note that Initialize must not be called if - -- Tree_Read is used. Note also that there is no Lock routine in this + -- Initialize Ureal tables. Note that there is no Lock routine in this -- unit. These tables are among the few tables that can be expanded -- during Gigi processing. - procedure Tree_Read; - -- Initializes internal tables from current tree file using the relevant - -- Table.Tree_Read routines. Note that Initialize should not be called if - -- Tree_Read is used. Tree_Read includes all necessary initialization. - - procedure Tree_Write; - -- Writes out internal tables to current tree file using the relevant - -- Table.Tree_Write routines. - function Rbase (Real : Ureal) return Nat; -- Return the base of the universal real