-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2004 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
-- Main_Unit is a body with a separate spec, in which case it is the
-- entity for the spec.
- Unit_Exception_Table_Present : Boolean;
- -- Set true if a unit exception table is present for the unit (i.e.
- -- zero cost exception handling is active and there is at least one
- -- subprogram in the extended unit).
-
-----------------
-- Units Table --
-----------------
-- Return unit number of file identified by given source pointer value.
-- This call must always succeed, since any valid source pointer value
-- belongs to some previously loaded module. If the given source pointer
- -- value is within an instantiation, this function returns the unit
- -- number of the templace, i.e. the unit containing the source code
- -- corresponding to the given Source_Ptr value. The version taking
- -- a Node_Id argument, N, simply applies the function to Sloc (N).
+ -- value is within an instantiation, this function returns the unit number
+ -- of the template, i.e. the unit containing the source code corresponding
+ -- to the given Source_Ptr value. The version taking a Node_Id argument, N,
+ -- simply applies the function to Sloc (N).
function Get_Code_Unit (N : Node_Or_Entity_Id) return Unit_Number_Type;
pragma Inline (Get_Code_Unit);
-- and the parent unit spec if it is separate.
function In_Extended_Main_Source_Unit (Loc : Source_Ptr) return Boolean;
- -- Same function as above, but argument is a source pointer rather
- -- than a node.
+ -- Same function as above, but argument is a source pointer
+
+ function In_Predefined_Unit (N : Node_Or_Entity_Id) return Boolean;
+ -- Returns True if the given node or entity appears within the source text
+ -- of a predefined unit (i.e. within Ada, Interfaces, System or within one
+ -- of the descendent packages of one of these three packages).
+
+ function In_Predefined_Unit (S : Source_Ptr) return Boolean;
+ -- Same function as above but argument is a source pointer
function Earlier_In_Extended_Unit (S1, S2 : Source_Ptr) return Boolean;
-- Given two Sloc values for which In_Same_Extended_Unit is true,
-- incremented value.
procedure Synchronize_Serial_Number;
- -- This function increments the Serial_Number field for the current
- -- unit but does not return the incremented value. This is used when
- -- there is a situation where one path of control increments a serial
- -- number (using Increment_Serial_Number), and the other path does not
- -- and it 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).
+ -- This function increments the Serial_Number field for the current unit
+ -- but does not return the incremented value. This is used when there
+ -- is a situation where one path of control increments a serial number
+ -- (using Increment_Serial_Number), and the other path does not and it 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 Replace_Linker_Option_String
(S : String_Id;
Match_String : String);
- -- Replace an existing Linker_Option if the prefix Match_String
- -- matches, otherwise call Store_Linker_Option_String.
+ -- Replace an existing Linker_Option if the prefix Match_String matches,
+ -- otherwise call Store_Linker_Option_String.
procedure Store_Compilation_Switch (Switch : String);
- -- Called to register a compilation switch, either front-end or
- -- back-end, which may influence the generated output file(s).
+ -- Called to register a compilation switch, either front-end or back-end,
+ -- which may influence the generated output file(s). Switch is the text of
+ -- the switch to store (except that -fRTS gets changed back to --RTS).
procedure Disable_Switch_Storing;
- -- Disable the registration of compilation switches with
- -- Store_Compilation_Switch. This is used to not register switches added
- -- automatically by the gcc driver.
+ -- Disable registration of switches by Store_Compilation_Switch. Used to
+ -- avoid registering switches added automatically by the gcc driver.
procedure Store_Linker_Option_String (S : String_Id);
-- This procedure is called to register the string from a pragma
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.
procedure List (File_Names_Only : Boolean := False);
-- Lists units in active library (i.e. generates output consisting of a
- -- sorted listing of the units represented in File table, with the
- -- exception of the main unit). If File_Names_Only is set to True, then
- -- the list includes only file names, and no other information. Otherwise
- -- the unit name and time stamp are also output. File_Names_Only also
- -- restricts the list to exclude any predefined files.
+ -- sorted listing of the units represented in File table, except for the
+ -- main unit). If File_Names_Only is set to True, then the list includes
+ -- only file names, and no other information. Otherwise the unit name and
+ -- time stamp are also output. File_Names_Only also restricts the list to
+ -- exclude any predefined files.
function Generic_Separately_Compiled (E : Entity_Id) return Boolean;
-- This is the old version of tbe documentation of this function:
-- because of the backward compatibility (to keep the ability to use old
-- compiler versions to build GNAT) compiling library generics is an
-- option. That is, now GNAT compiles a library generic as an ordinary
- -- unit, but it also can build an exeutable in case if its library
- -- contains some (or all) predefined generics non compiled. See 9628-002
- -- for the description of changes to be done to get rid of a special
- -- processing of library generic.
+ -- unit, but it also can build an exeutable in case if its library contains
+ -- some (or all) predefined generics non compiled. See 9628-002 for the
+ -- description of changes to be done to get rid of a special processing of
+ -- library generic.
--
-- So now this function returns TRUE if a generic MUST be separately
-- compiled with the current approach.
function Generic_Separately_Compiled
(Sfile : File_Name_Type) return Boolean;
- -- Same as the previous function, but works directly on a unit file name.
+ -- Same as the previous function, but works directly on a unit file name
private
pragma Inline (Cunit);
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,
type Unit_Ref_Table is array (Pos range <>) of Unit_Number_Type;
-- Type to hold list of indirect references to unit number table
- -- The Load_Stack table contains a list of unit numbers (indexes into the
- -- unit table) of units being loaded on a single dependency chain. The
- -- First entry is the main unit. The second entry, if present is a unit
- -- on which the first unit depends, etc. This stack is used to generate
- -- error messages showing the dependency chain if a file is not found.
- -- The Load function makes an entry in this table when it is called, and
- -- removes the entry just before it returns.
+ type Load_Stack_Entry is record
+ Unit_Number : Unit_Number_Type;
+ From_Limited_With : Boolean;
+ end record;
+
+ -- The Load_Stack table contains a list of unit numbers (indices into the
+ -- unit table) of units being loaded on a single dependency chain, and a
+ -- flag to indicate whether this unit is loaded through a limited_with
+ -- clause. The First entry is the main unit. The second entry, if present
+ -- is a unit on which the first unit depends, etc. This stack is used to
+ -- generate error messages showing the dependency chain if a file is not
+ -- found, or whether a true circular dependency exists. The Load_Unit
+ -- function makes an entry in this table when it is called, and removes
+ -- the entry just before it returns.
package Load_Stack is new Table.Table (
- Table_Component_Type => Unit_Number_Type,
- Table_Index_Type => Nat,
+ Table_Component_Type => Load_Stack_Entry,
+ Table_Index_Type => Int,
Table_Low_Bound => 0,
Table_Initial => Alloc.Load_Stack_Initial,
Table_Increment => Alloc.Load_Stack_Increment,
OSDN Git Service
