-- --
-- 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- --
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,
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,
Elmts.Tree_Write;
end Tree_Write;
+ ------------
+ -- Unlock --
+ ------------
+
+ procedure Unlock is
+ begin
+ Elists.Locked := False;
+ Elmts.Locked := False;
+ end Unlock;
+
end Elists;
-- --
-- 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- --
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
-- --
-- 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- --
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;
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 --
-----------------
-- --
-- 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- --
-- 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
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.
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,
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,
-- --
-- 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- --
-- 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 --
-----------------
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
-- 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);
-- 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
-- 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,
-- --
-- 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- --
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,
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,
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,
--------------------------
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;
------------
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;
-- --
-- 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- --
------------------------------------------------------------------------------
with Err_Vars; use Err_Vars;
-with Namet; use Namet;
with Prj.Attr; use Prj.Attr;
with Prj.Err; use Prj.Err;
with Snames;
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.
-- 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);
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
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
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;
-- 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;
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
-- 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;
-- --
-- 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- --
-- 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
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,
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");
-- 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
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);
-- --
-- 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- --
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
-- --
-- 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- --
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,
-- --
-- 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- --
-- 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;
--------------------------------
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
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;
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 --
--------
-- --
-- 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- --
with Alloc;
with Casing; use Casing;
+with Namet; use Namet;
with Table;
with Types; use Types;
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
-- 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
-- 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).
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,
-- --
-- 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- --
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,
-- --
-- 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- --
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,
-- --
-- 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- --
-- 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,
OSDN Git Service
