diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/elists.adb | 16 | ||||
| -rw-r--r-- | gcc/ada/elists.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/lib.adb | 14 | ||||
| -rw-r--r-- | gcc/ada/lib.ads | 48 | ||||
| -rw-r--r-- | gcc/ada/namet.ads | 110 | ||||
| -rw-r--r-- | gcc/ada/nlists.adb | 30 | ||||
| -rw-r--r-- | gcc/ada/prj-strt.adb | 54 | ||||
| -rw-r--r-- | gcc/ada/repinfo.adb | 26 | ||||
| -rw-r--r-- | gcc/ada/repinfo.ads | 10 | ||||
| -rw-r--r-- | gcc/ada/sem_elim.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sinput.adb | 19 | ||||
| -rw-r--r-- | gcc/ada/sinput.ads | 65 | ||||
| -rw-r--r-- | gcc/ada/stringt.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/uintp.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/urealp.adb | 18 |
15 files changed, 341 insertions, 86 deletions
diff --git a/gcc/ada/elists.adb b/gcc/ada/elists.adb index 831f952..243b184 100644 --- a/gcc/ada/elists.adb +++ b/gcc/ada/elists.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -90,7 +90,7 @@ package body Elists is package Elists is new Table.Table ( Table_Component_Type => Elist_Header, - Table_Index_Type => Elist_Id, + Table_Index_Type => Elist_Id'Base, Table_Low_Bound => First_Elist_Id, Table_Initial => Alloc.Elists_Initial, Table_Increment => Alloc.Elists_Increment, @@ -103,7 +103,7 @@ package body Elists is package Elmts is new Table.Table ( Table_Component_Type => Elmt_Item, - Table_Index_Type => Elmt_Id, + Table_Index_Type => Elmt_Id'Base, Table_Low_Bound => First_Elmt_Id, Table_Initial => Alloc.Elmts_Initial, Table_Increment => Alloc.Elmts_Increment, @@ -482,4 +482,14 @@ package body Elists is Elmts.Tree_Write; end Tree_Write; + ------------ + -- Unlock -- + ------------ + + procedure Unlock is + begin + Elists.Locked := False; + Elmts.Locked := False; + end Unlock; + end Elists; diff --git a/gcc/ada/elists.ads b/gcc/ada/elists.ads index 6ddb458..6a0fb00 100644 --- a/gcc/ada/elists.ads +++ b/gcc/ada/elists.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -62,6 +62,9 @@ package Elists is procedure Lock; -- Lock tables used for element lists before calling backend + 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 diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index 1a92677..c4afe04 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -38,7 +38,6 @@ pragma Style_Checks (All_Checks); with Atree; use Atree; with Einfo; use Einfo; with Fname; use Fname; -with Namet; use Namet; with Output; use Output; with Sinfo; use Sinfo; with Sinput; use Sinput; @@ -1027,6 +1026,17 @@ package body Lib is end loop; end Tree_Write; + ------------ + -- Unlock -- + ------------ + + procedure Unlock is + begin + Linker_Option_Lines.Locked := False; + Load_Stack.Locked := False; + Units.Locked := False; + end Unlock; + ----------------- -- Version_Get -- ----------------- diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index afa7862..73c7b7a 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -35,8 +35,9 @@ -- information. It contains the routine to load subsidiary units. with Alloc; +with Namet; use Namet; with Table; -with Types; use Types; +with Types; use Types; package Lib is @@ -562,6 +563,9 @@ package Lib is procedure Lock; -- Lock internal tables before calling back end + procedure Unlock; + -- Unlock internal 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. @@ -658,18 +662,46 @@ private Cunit : Node_Id; Cunit_Entity : Entity_Id; Dependency_Num : Int; - Fatal_Error : Boolean; - Generate_Code : Boolean; - Has_RACW : Boolean; Ident_String : Node_Id; - Loading : Boolean; Main_Priority : Int; Serial_Number : Nat; Version : Word; - Dynamic_Elab : Boolean; Error_Location : Source_Ptr; + Fatal_Error : Boolean; + Generate_Code : Boolean; + Has_RACW : Boolean; + Dynamic_Elab : Boolean; + Loading : Boolean; end record; + -- 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. + + for Unit_Record use record + Unit_File_Name at 0 range 0 .. 31; + Unit_Name at 4 range 0 .. 31; + Munit_Index at 8 range 0 .. 31; + Expected_Unit at 12 range 0 .. 31; + Source_Index at 16 range 0 .. 31; + Cunit at 20 range 0 .. 31; + Cunit_Entity at 24 range 0 .. 31; + Dependency_Num at 28 range 0 .. 31; + Ident_String at 32 range 0 .. 31; + Main_Priority at 36 range 0 .. 31; + Serial_Number at 40 range 0 .. 31; + Version at 44 range 0 .. 31; + Error_Location at 48 range 0 .. 31; + Fatal_Error at 52 range 0 .. 7; + Generate_Code at 53 range 0 .. 7; + Has_RACW at 54 range 0 .. 7; + Dynamic_Elab at 55 range 0 .. 7; + Loading at 56 range 0 .. 31; + end record; + + for Unit_Record'Size use 60 * 8; + -- This ensures that we did not leave out any fields + package Units is new Table.Table ( Table_Component_Type => Unit_Record, Table_Index_Type => Unit_Number_Type, @@ -740,7 +772,7 @@ private package Load_Stack is new Table.Table ( Table_Component_Type => Load_Stack_Entry, - Table_Index_Type => Nat, + Table_Index_Type => Int, Table_Low_Bound => 0, Table_Initial => Alloc.Load_Stack_Initial, Table_Increment => Alloc.Load_Stack_Increment, diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index a669485..6043f20 100644 --- a/gcc/ada/namet.ads +++ b/gcc/ada/namet.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -136,6 +136,37 @@ package Namet is -- Length of name stored in Name_Buffer. Used as an input parameter for -- Name_Find, and as an output value by Get_Name_String, or Write_Name. + ----------------------------- + -- Types for Namet Package -- + ----------------------------- + + -- Name_Id values are used to identify entries in the names table. Except + -- for the special values No_Name, and Error_Name, they are subscript + -- values for the Names table defined in package Namet. + + -- Note that with only a few exceptions, which are clearly documented, the + -- type Name_Id should be regarded as a private type. In particular it is + -- never appropriate to perform arithmetic operations using this type. + + type Name_Id is range Names_Low_Bound .. Names_High_Bound; + for Name_Id'Size use 32; + -- Type used to identify entries in the names table + + No_Name : constant Name_Id := Names_Low_Bound; + -- The special Name_Id value No_Name is used in the parser to indicate + -- a situation where no name is present (e.g. on a loop or block). + + Error_Name : constant Name_Id := Names_Low_Bound + 1; + -- The special Name_Id value Error_Name is used in the parser to + -- indicate that some kind of error was encountered in scanning out + -- the relevant name, so it does not have a representable label. + + subtype Error_Name_Or_No_Name is Name_Id range No_Name .. Error_Name; + -- Used to test for either error name or no name + + First_Name_Id : constant Name_Id := Names_Low_Bound + 2; + -- Subscript of first entry in names table + ----------------- -- Subprograms -- ----------------- @@ -153,7 +184,7 @@ package Namet is function Get_Name_String (Id : Name_Id) return String; -- This functional form returns the result as a string without affecting - -- the contents of either Name_Buffer or Name_Len. + -- the contents of either Name_Buffer or Name_Len. The lower bound is 1. procedure Get_Unqualified_Name_String (Id : Name_Id); -- Similar to the above except that qualification (as defined in unit @@ -215,13 +246,12 @@ package Namet is -- that Initialize must not be called if Tree_Read is used. procedure Lock; - -- Lock name table before calling back end. Space for up to 10 extra - -- names and 1000 extra characters is reserved before the table is locked. + -- Lock name tables before calling back end. We reserve some extra space + -- before locking to avoid unnecessary inefficiencies when we unlock. procedure Unlock; - -- Unlocks the name table to allow use of the 10 extra names and 1000 - -- extra characters reserved by the Lock call. See gnat1drv for details of - -- the need for this. + -- 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. function Length_Of_Name (Id : Name_Id) return Nat; pragma Inline (Length_Of_Name); @@ -367,6 +397,58 @@ package Namet is -- described for Get_Decoded_Name_String, and the resulting value stored -- in Name_Len and Name_Buffer is the decoded name. + ------------------------------ + -- File and Unit Name Types -- + ------------------------------ + + -- These are defined here in Namet rather than Fname and Uname to avoid + -- problems with dependencies, and to avoid dragging in Fname and Uname + -- into many more files, but it would be cleaner to move to Fname/Uname. + + type File_Name_Type is new Name_Id; + -- File names are stored in the names table and this type is used to + -- indicate that a Name_Id value is being used to hold a simple file name + -- (which does not include any directory information). + + No_File : constant File_Name_Type := File_Name_Type (No_Name); + -- Constant used to indicate no file is present (this is used for example + -- when a search for a file indicates that no file of the name exists). + + Error_File_Name : constant File_Name_Type := File_Name_Type (Error_Name); + -- The special File_Name_Type value Error_File_Name is used to indicate + -- a unit name where some previous processing has found an error. + + subtype Error_File_Name_Or_No_File is + File_Name_Type range No_File .. Error_File_Name; + -- Used to test for either error file name or no file + + type Path_Name_Type is new Name_Id; + -- Path names are stored in the names table and this type is used to + -- indicate that a Name_Id value is being used to hold a path name (that + -- may contain directory information). + + No_Path : constant Path_Name_Type := Path_Name_Type (No_Name); + -- Constant used to indicate no path name is present + + type Unit_Name_Type is new Name_Id; + -- Unit names are stored in the names table and this type is used to + -- indicate that a Name_Id value is being used to hold a unit name, which + -- terminates in %b for a body or %s for a spec. + + No_Unit_Name : constant Unit_Name_Type := Unit_Name_Type (No_Name); + -- Constant used to indicate no file name present + + Error_Unit_Name : constant Unit_Name_Type := Unit_Name_Type (Error_Name); + -- The special Unit_Name_Type value Error_Unit_Name is used to indicate + -- a unit name where some previous processing has found an error. + + subtype Error_Unit_Name_Or_No_Unit_Name is + Unit_Name_Type range No_Unit_Name .. Error_Unit_Name; + + ------------------------ + -- Debugging Routines -- + ------------------------ + procedure wn (Id : Name_Id); pragma Export (Ada, wn); -- This routine is intended for debugging use only (i.e. it is intended to @@ -427,12 +509,24 @@ private -- Int Value associated with this name end record; + for Name_Entry use record + Name_Chars_Index at 0 range 0 .. 31; + Name_Len at 4 range 0 .. 15; + Byte_Info at 6 range 0 .. 7; + Name_Has_No_Encodings at 7 range 0 .. 7; + Hash_Link at 8 range 0 .. 31; + Int_Info at 12 range 0 .. 31; + end record; + + for Name_Entry'Size use 16 * 8; + -- This ensures that we did not leave out any fields + -- This is the table that is referenced by Name_Id entries. -- It contains one entry for each unique name in the table. package Name_Entries is new Table.Table ( Table_Component_Type => Name_Entry, - Table_Index_Type => Name_Id, + Table_Index_Type => Name_Id'Base, Table_Low_Bound => First_Name_Id, Table_Initial => Alloc.Names_Initial, Table_Increment => Alloc.Names_Increment, diff --git a/gcc/ada/nlists.adb b/gcc/ada/nlists.adb index 5d4ef38..8778a9e 100644 --- a/gcc/ada/nlists.adb +++ b/gcc/ada/nlists.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -68,7 +68,7 @@ package body Nlists is package Lists is new Table.Table ( Table_Component_Type => List_Header, - Table_Index_Type => List_Id, + Table_Index_Type => List_Id'Base, Table_Low_Bound => First_List_Id, Table_Initial => Alloc.Lists_Initial, Table_Increment => Alloc.Lists_Increment, @@ -88,7 +88,7 @@ package body Nlists is package Next_Node is new Table.Table ( Table_Component_Type => Node_Id, - Table_Index_Type => Node_Id, + Table_Index_Type => Node_Id'Base, Table_Low_Bound => First_Node_Id, Table_Initial => Alloc.Orig_Nodes_Initial, Table_Increment => Alloc.Orig_Nodes_Increment, @@ -96,7 +96,7 @@ package body Nlists is package Prev_Node is new Table.Table ( Table_Component_Type => Node_Id, - Table_Index_Type => Node_Id, + Table_Index_Type => Node_Id'Base, Table_Low_Bound => First_Node_Id, Table_Initial => Alloc.Orig_Nodes_Initial, Table_Increment => Alloc.Orig_Nodes_Increment, @@ -131,9 +131,20 @@ package body Nlists is -------------------------- procedure Allocate_List_Tables (N : Node_Id) is + Old_Last : constant Node_Id'Base := Next_Node.Last; + begin + pragma Assert (N >= Old_Last); 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 unitialized junk. + + for J in Old_Last + 1 .. N loop + Next_Node.Table (J) := Empty; + Prev_Node.Table (J) := Empty; + end loop; end Allocate_List_Tables; ------------ @@ -1379,4 +1390,15 @@ package body Nlists is Prev_Node.Tree_Write; end Tree_Write; + ------------ + -- Unlock -- + ------------ + + procedure Unlock is + begin + Lists.Locked := False; + Prev_Node.Locked := False; + Next_Node.Locked := False; + end Unlock; + end Nlists; diff --git a/gcc/ada/prj-strt.adb b/gcc/ada/prj-strt.adb index 0fdc21c..c5a6992 100644 --- a/gcc/ada/prj-strt.adb +++ b/gcc/ada/prj-strt.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2007, 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- -- @@ -25,7 +25,6 @@ ------------------------------------------------------------------------------ with Err_Vars; use Err_Vars; -with Namet; use Namet; with Prj.Attr; use Prj.Attr; with Prj.Err; use Prj.Err; with Snames; @@ -58,21 +57,23 @@ package body Prj.Strt is Choice_Node_Low_Bound; package Choices is - new Table.Table (Table_Component_Type => Choice_String, - Table_Index_Type => Choice_Node_Id, - Table_Low_Bound => First_Choice_Node_Id, - Table_Initial => Choices_Initial, - Table_Increment => Choices_Increment, - Table_Name => "Prj.Strt.Choices"); + new Table.Table + (Table_Component_Type => Choice_String, + Table_Index_Type => Choice_Node_Id'Base, + Table_Low_Bound => First_Choice_Node_Id, + Table_Initial => Choices_Initial, + Table_Increment => Choices_Increment, + Table_Name => "Prj.Strt.Choices"); -- Used to store the case labels and check that there is no duplicate package Choice_Lasts is - new Table.Table (Table_Component_Type => Choice_Node_Id, - Table_Index_Type => Nat, - Table_Low_Bound => 1, - Table_Initial => 10, - Table_Increment => 100, - Table_Name => "Prj.Strt.Choice_Lasts"); + new Table.Table + (Table_Component_Type => Choice_Node_Id, + Table_Index_Type => Nat, + Table_Low_Bound => 1, + Table_Initial => 10, + Table_Increment => 100, + Table_Name => "Prj.Strt.Choice_Lasts"); -- Used to store the indices of the choices in table Choices, -- to distinguish nested case constructions. @@ -87,12 +88,13 @@ package body Prj.Strt is -- Store the identifier and the location of a simple name package Names is - new Table.Table (Table_Component_Type => Name_Location, - Table_Index_Type => Nat, - Table_Low_Bound => 1, - Table_Initial => 10, - Table_Increment => 100, - Table_Name => "Prj.Strt.Names"); + new Table.Table + (Table_Component_Type => Name_Location, + Table_Index_Type => Nat, + Table_Low_Bound => 1, + Table_Initial => 10, + Table_Increment => 100, + Table_Name => "Prj.Strt.Names"); -- Used to accumulate the single names of a name procedure Add (This_String : Name_Id); @@ -193,7 +195,7 @@ package body Prj.Strt is if Current_Attribute = Empty_Attribute then Error_Msg_Name_1 := Token_Name; - Error_Msg ("unknown attribute %", Token_Ptr); + Error_Msg ("unknown attribute %%", Token_Ptr); Reference := Empty_Node; -- Scan past the attribute name @@ -293,7 +295,7 @@ package body Prj.Strt is if Non_Used = 1 then Error_Msg_Name_1 := Choices.Table (First_Non_Used).The_String; - Error_Msg ("?value { is not used as label", Case_Location); + Error_Msg ("?value %% is not used as label", Case_Location); -- If several are not used, report a warning for each one of them @@ -305,7 +307,7 @@ package body Prj.Strt is for Choice in First_Non_Used .. Choices.Last loop if not Choices.Table (Choice).Already_Used then Error_Msg_Name_1 := Choices.Table (Choice).The_String; - Error_Msg ("\?{", Case_Location); + Error_Msg ("\?%%", Case_Location); end if; end loop; end if; @@ -484,7 +486,7 @@ package body Prj.Strt is -- case construction; report an error. Error_Msg_Name_1 := Choice_String; - Error_Msg ("duplicate case label {", Token_Ptr); + Error_Msg ("duplicate case label %%", Token_Ptr); else Choices.Table (Choice).Already_Used := True; end if; @@ -497,7 +499,7 @@ package body Prj.Strt is if not Found then Error_Msg_Name_1 := Choice_String; - Error_Msg ("illegal case label {", Token_Ptr); + Error_Msg ("illegal case label %%", Token_Ptr); end if; -- Scan past the label @@ -607,7 +609,7 @@ package body Prj.Strt is -- This is a repetition, report an error Error_Msg_Name_1 := String_Value; - Error_Msg ("duplicate value { in type", Token_Ptr); + Error_Msg ("duplicate value %% in type", Token_Ptr); exit; end if; diff --git a/gcc/ada/repinfo.adb b/gcc/ada/repinfo.adb index f323442..93d5fd4 100644 --- a/gcc/ada/repinfo.adb +++ b/gcc/ada/repinfo.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1999-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2007, 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- -- @@ -63,9 +63,8 @@ package body Repinfo is -- Representation of gcc Expressions -- --------------------------------------- - -- This table is used only if Frontend_Layout_On_Target is False, so that - -- gigi lays out dynamic size/offset fields using encoded gcc - -- expressions. + -- This table is used only if Frontend_Layout_On_Target is False, so gigi + -- lays out dynamic size/offset fields using encoded gcc expressions. -- 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 @@ -81,6 +80,20 @@ package body Repinfo is Op3 : Node_Ref_Or_Val; end record; + -- 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. + + for Exp_Node use record + Expr at 0 range 0 .. 31; + Op1 at 4 range 0 .. 31; + Op2 at 8 range 0 .. 31; + Op3 at 12 range 0 .. 31; + end record; + + for Exp_Node'Size use 16 * 8; + -- This ensures that we did not leave out any fields + package Rep_Table is new Table.Table ( Table_Component_Type => Exp_Node, Table_Index_Type => Nat, @@ -672,6 +685,7 @@ package body Repinfo is when Convention_Protected => Write_Line ("Protected"); when Convention_Assembler => Write_Line ("Assembler"); when Convention_C => Write_Line ("C"); + when Convention_CIL => Write_Line ("CIL"); when Convention_COBOL => Write_Line ("COBOL"); when Convention_CPP => Write_Line ("C++"); when Convention_Fortran => Write_Line ("Fortran"); @@ -782,7 +796,7 @@ package body Repinfo is -- length, for the purpose of lining things up nicely. Max_Name_Length := 0; - Max_Suni_Length := 0; + Max_Suni_Length := 0; Comp := First_Component_Or_Discriminant (Ent); while Present (Comp) loop @@ -983,7 +997,7 @@ package body Repinfo is else Create_Repinfo_File_Access.all - (File_Name (Source_Index (U))); + (Get_Name_String (File_Name (Source_Index (U)))); Set_Special_Output (Write_Info_Line'Access); List_Entities (Cunit_Entity (U)); Set_Special_Output (null); diff --git a/gcc/ada/repinfo.ads b/gcc/ada/repinfo.ads index 9fc16c2..beaaf98 100644 --- a/gcc/ada/repinfo.ads +++ b/gcc/ada/repinfo.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1999-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1999-2007, 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- -- @@ -182,10 +182,10 @@ package Repinfo is Op1 : Node_Ref_Or_Val; Op2 : Node_Ref_Or_Val := No_Uint; Op3 : Node_Ref_Or_Val := No_Uint) return Node_Ref; - -- Creates a node with using the tree code defined by Expr and from - -- 1-3 operands as required (unused operands set as shown to No_Uint) - -- Note that this call can be used to create a discriminant reference - -- by using (Expr => Discrim_Val, Op1 => discriminant_number). + -- Creates a node using the tree code defined by Expr and from one to three + -- operands as required (unused operands set as shown to No_Uint) Note that + -- this call can be used to create a discriminant reference by using (Expr + -- => Discrim_Val, Op1 => discriminant_number). function Create_Discrim_Ref (Discr : Entity_Id) return Node_Ref; -- Creates a refrerence to the discriminant whose entity is Discr diff --git a/gcc/ada/sem_elim.adb b/gcc/ada/sem_elim.adb index 51a2a10..f7b8c1a 100644 --- a/gcc/ada/sem_elim.adb +++ b/gcc/ada/sem_elim.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1997-2004 Free Software Foundation, Inc. -- +-- Copyright (C) 1997-2007, 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- -- @@ -218,7 +218,7 @@ package body Sem_Elim is package Elim_Entities is new Table.Table ( Table_Component_Type => Elim_Entity_Entry, - Table_Index_Type => Name_Id, + Table_Index_Type => Name_Id'Base, Table_Low_Bound => First_Name_Id, Table_Initial => 50, Table_Increment => 200, diff --git a/gcc/ada/sinput.adb b/gcc/ada/sinput.adb index 7efc71a..616b73d 100644 --- a/gcc/ada/sinput.adb +++ b/gcc/ada/sinput.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -35,7 +35,6 @@ pragma Style_Checks (All_Checks); -- Subprograms not all in alpha order with Debug; use Debug; -with Namet; use Namet; with Opt; use Opt; with Output; use Output; with Tree_IO; use Tree_IO; @@ -575,8 +574,8 @@ package body Sinput is -------------------------------- procedure Register_Source_Ref_Pragma - (File_Name : Name_Id; - Stripped_File_Name : Name_Id; + (File_Name : File_Name_Type; + Stripped_File_Name : File_Name_Type; Mapped_Line : Nat; Line_After_Pragma : Physical_Line_Number) is @@ -587,7 +586,7 @@ package body Sinput is ML : Logical_Line_Number; begin - if File_Name /= No_Name then + if File_Name /= No_File then SFR.Reference_Name := Stripped_File_Name; SFR.Full_Ref_Name := File_Name; @@ -1202,6 +1201,16 @@ package body Sinput is Source_File.Table (S).Lines_Table_Max := Physical_Line_Number (Max); end Trim_Lines_Table; + ------------ + -- Unlock -- + ------------ + + procedure Unlock is + begin + Source_File.Locked := False; + Source_File.Release; + end Unlock; + -------- -- wl -- -------- diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads index cd472c6..db240ff 100644 --- a/gcc/ada/sinput.ads +++ b/gcc/ada/sinput.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -66,6 +66,7 @@ with Alloc; with Casing; use Casing; +with Namet; use Namet; with Table; with Types; use Types; @@ -323,6 +324,9 @@ package Sinput is procedure Lock; -- Lock internal tables + procedure Unlock; + -- Unlock internal tables + Main_Source_File : Source_File_Index := No_Source_File; -- This is set to the source file index of the main unit @@ -517,8 +521,8 @@ package Sinput is -- physical line number. procedure Register_Source_Ref_Pragma - (File_Name : Name_Id; - Stripped_File_Name : Name_Id; + (File_Name : File_Name_Type; + Stripped_File_Name : File_Name_Type; Mapped_Line : Nat; Line_After_Pragma : Physical_Line_Number); -- Register a source reference pragma, the parameter File_Name is the @@ -670,29 +674,28 @@ private -- See earlier descriptions for meanings of public fields type Source_File_Record is record - File_Name : File_Name_Type; - File_Type : Type_Of_File; Reference_Name : File_Name_Type; Debug_Source_Name : File_Name_Type; Full_Debug_Name : File_Name_Type; Full_File_Name : File_Name_Type; Full_Ref_Name : File_Name_Type; - Inlined_Body : Boolean; - License : License_Type; Num_SRef_Pragmas : Nat; First_Mapped_Line : Logical_Line_Number; Source_Text : Source_Buffer_Ptr; Source_First : Source_Ptr; Source_Last : Source_Ptr; - Time_Stamp : Time_Stamp_Type; Source_Checksum : Word; Last_Source_Line : Physical_Line_Number; - Keyword_Casing : Casing_Type; - Identifier_Casing : Casing_Type; Instantiation : Source_Ptr; Template : Source_File_Index; Unit : Unit_Number_Type; + Time_Stamp : Time_Stamp_Type; + File_Type : Type_Of_File; + Inlined_Body : Boolean; + License : License_Type; + Keyword_Casing : Casing_Type; + Identifier_Casing : Casing_Type; -- The following fields are for internal use only (i.e. only in the -- body of Sinput or its children, with no direct access by clients). @@ -722,6 +725,48 @@ private end record; + -- 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. + + AS : constant Pos := Standard'Address_Size; + + for Source_File_Record use record + File_Name at 0 range 0 .. 31; + Reference_Name at 4 range 0 .. 31; + Debug_Source_Name at 8 range 0 .. 31; + Full_Debug_Name at 12 range 0 .. 31; + Full_File_Name at 16 range 0 .. 31; + Full_Ref_Name at 20 range 0 .. 31; + Num_SRef_Pragmas at 24 range 0 .. 31; + First_Mapped_Line at 28 range 0 .. 31; + Source_First at 32 range 0 .. 31; + Source_Last at 36 range 0 .. 31; + Source_Checksum at 40 range 0 .. 31; + Last_Source_Line at 44 range 0 .. 31; + Instantiation at 48 range 0 .. 31; + Template at 52 range 0 .. 31; + Unit at 56 range 0 .. 31; + Time_Stamp at 60 range 0 .. 8 * Time_Stamp_Length - 1; + File_Type at 74 range 0 .. 7; + Inlined_Body at 75 range 0 .. 7; + License at 76 range 0 .. 7; + Keyword_Casing at 77 range 0 .. 7; + Identifier_Casing at 78 range 0 .. 15; + Sloc_Adjust at 80 range 0 .. 31; + Lines_Table_Max at 84 range 0 .. 31; + + -- The following fields are pointers, so we have to specialize their + -- lengths using pointer size, obtained above as Standard'Address_Size. + + Source_Text at 88 range 0 .. AS - 1; + Lines_Table at 88 range AS .. AS * 2 - 1; + Logical_Lines_Table at 88 range AS * 2 .. AS * 3 - 1; + end record; + + for Source_File_Record'Size use 88 * 8 + AS * 3; + -- This ensures that we did not leave out any fields + package Source_File is new Table.Table ( Table_Component_Type => Source_File_Record, Table_Index_Type => Source_File_Index, diff --git a/gcc/ada/stringt.adb b/gcc/ada/stringt.adb index 0a5fbb2..1c03a88 100644 --- a/gcc/ada/stringt.adb +++ b/gcc/ada/stringt.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -61,7 +61,7 @@ package body Stringt is package Strings is new Table.Table ( Table_Component_Type => String_Entry, - Table_Index_Type => String_Id, + Table_Index_Type => String_Id'Base, Table_Low_Bound => First_String_Id, Table_Initial => Alloc.Strings_Initial, Table_Increment => Alloc.Strings_Increment, diff --git a/gcc/ada/uintp.ads b/gcc/ada/uintp.ads index ad4782b..e689cf8 100644 --- a/gcc/ada/uintp.ads +++ b/gcc/ada/uintp.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -518,7 +518,7 @@ private package Uints is new Table.Table ( Table_Component_Type => Uint_Entry, - Table_Index_Type => Uint, + Table_Index_Type => Uint'Base, Table_Low_Bound => Uint_First_Entry, Table_Initial => Alloc.Uints_Initial, Table_Increment => Alloc.Uints_Increment, diff --git a/gcc/ada/urealp.adb b/gcc/ada/urealp.adb index 4897bf1..737e4b4 100644 --- a/gcc/ada/urealp.adb +++ b/gcc/ada/urealp.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -57,9 +57,23 @@ package body Urealp is -- Flag set if value is negative end record; + -- 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. + + for Ureal_Entry use record + Num at 0 range 0 .. 31; + Den at 4 range 0 .. 31; + Rbase at 8 range 0 .. 31; + Negative at 12 range 0 .. 31; + end record; + + for Ureal_Entry'Size use 16 * 8; + -- This ensures that we did not leave out any fields + package Ureals is new Table.Table ( Table_Component_Type => Ureal_Entry, - Table_Index_Type => Ureal, + Table_Index_Type => Ureal'Base, Table_Low_Bound => Ureal_First_Entry, Table_Initial => Alloc.Ureals_Initial, Table_Increment => Alloc.Ureals_Increment, |