Skip to content

R
riscv-gcc-1
Commit 996ae0b0 by Richard Kenner
Options

New Language: Ada 

From-SVN: r45959
parent 2b3d3db6
Showing with 4771 additions and 0 deletions
gcc/ada/scans.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S C A N S --
-- --
-- B o d y --
-- --
-- $Revision: 1.12 $
-- --
-- Copyright (C) 1992-2001 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
package body Scans is
------------------------
-- Restore_Scan_State --
------------------------
procedure Restore_Scan_State (Saved_State : in Saved_Scan_State) is
begin
Scan_Ptr := Saved_State.Save_Scan_Ptr;
Token := Saved_State.Save_Token;
Token_Ptr := Saved_State.Save_Token_Ptr;
Current_Line_Start := Saved_State.Save_Current_Line_Start;
Start_Column := Saved_State.Save_Start_Column;
Checksum := Saved_State.Save_Checksum;
First_Non_Blank_Location := Saved_State.Save_First_Non_Blank_Location;
Token_Node := Saved_State.Save_Token_Node;
Token_Name := Saved_State.Save_Token_Name;
Prev_Token := Saved_State.Save_Prev_Token;
Prev_Token_Ptr := Saved_State.Save_Prev_Token_Ptr;
end Restore_Scan_State;
---------------------
-- Save_Scan_State --
---------------------
procedure Save_Scan_State (Saved_State : out Saved_Scan_State) is
begin
Saved_State.Save_Scan_Ptr := Scan_Ptr;
Saved_State.Save_Token := Token;
Saved_State.Save_Token_Ptr := Token_Ptr;
Saved_State.Save_Current_Line_Start := Current_Line_Start;
Saved_State.Save_Start_Column := Start_Column;
Saved_State.Save_Checksum := Checksum;
Saved_State.Save_First_Non_Blank_Location := First_Non_Blank_Location;
Saved_State.Save_Token_Node := Token_Node;
Saved_State.Save_Token_Name := Token_Name;
Saved_State.Save_Prev_Token := Prev_Token;
Saved_State.Save_Prev_Token_Ptr := Prev_Token_Ptr;
end Save_Scan_State;
end Scans;
gcc/ada/scn.adb 0 → 100644
This diff is collapsed. Click to expand it.
gcc/ada/scn.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S C N --
-- --
-- S p e c --
-- --
-- $Revision: 1.19 $
-- --
-- Copyright (C) 1992-2000 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package contains the lexical analyzer routines. This is used both
-- for scanning Ada source files and also for scanning Ada project files.
with Casing; use Casing;
with Types; use Types;
package Scn is
procedure Initialize_Scanner
(Unit : Unit_Number_Type;
Index : Source_File_Index);
-- Initialize lexical scanner for scanning a new file. The caller has
-- completed the construction of the Units.Table entry for the specified
-- Unit and Index references the corresponding source file. A special
-- case is when Unit = No_Unit_Number, and Index corresponds to the
-- source index for reading the configuration pragma file.
procedure Scan;
-- Scan scans out the next token, and advances the scan state accordingly
-- (see package Scan_State for details). If the scan encounters an illegal
-- token, then an error message is issued pointing to the bad character,
-- and Scan returns a reasonable substitute token of some kind.
function Scan_First_Char return Source_Ptr;
-- This routine returns the position in Source of the first non-blank
-- character on the current line, used for certain error recovery actions.
procedure Scan_Reserved_Identifier (Force_Msg : Boolean);
-- This procedure is called to convert the current token, which the caller
-- has checked is for a reserved word, to an equivalent identifier. This is
-- of course only used in error situations where the parser can detect that
-- a reserved word is being used as an identifier. An appropriate error
-- message, pointing to the token, is also issued if either this is the
-- first occurrence of misuse of this identifier, or if Force_Msg is True.
function Determine_Token_Casing return Casing_Type;
pragma Inline (Determine_Token_Casing);
-- Determines the casing style of the current token, which is
-- either a keyword or an identifier. See also package Casing.
end Scn;
gcc/ada/sdefault.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S D E F A U L T --
-- --
-- S p e c --
-- --
-- $Revision: 1.8 $ --
-- --
-- Copyright (C) 1992-1999 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Types; use Types;
package Sdefault is
-- This package contains functions that return the default values for
-- the include and object file directories, target name, and the default
-- library subdirectory (libsubdir) prefix.
function Include_Dir_Default_Name return String_Ptr;
function Object_Dir_Default_Name return String_Ptr;
function Target_Name return String_Ptr;
function Search_Dir_Prefix return String_Ptr;
end Sdefault;
gcc/ada/sem.adb 0 → 100644
This diff is collapsed. Click to expand it.
gcc/ada/sem.ads 0 → 100644
This diff is collapsed. Click to expand it.
gcc/ada/sem_aggr.adb 0 → 100644
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/sem_aggr.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ A G G R --
-- --
-- S p e c --
-- --
-- $Revision: 1.3 $ --
-- --
-- Copyright (C) 1992,1993,1994 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package contains the resolution code for aggregates. It is logically
-- part of Sem_Res, but is split off since the aggregate code is so complex.
with Types; use Types;
package Sem_Aggr is
procedure Resolve_Aggregate (N : Node_Id; Typ : Entity_Id);
procedure Resolve_Extension_Aggregate (N : Node_Id; Typ : Entity_Id);
end Sem_Aggr;
gcc/ada/sem_attr.adb 0 → 100644
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/sem_case.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ C A S E --
-- --
-- S p e c --
-- --
-- $Revision: 1.5 $ --
-- --
-- Copyright (C) 1996 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Types; use Types;
-- Package containing all the routines to proces a list of discrete choices.
-- Such lists can occur in 3 different constructs: case statements, array
-- aggregates and record variants. We have factorized what used to be 3 very
-- similar sets of routines here. If you didn't figure it out already Choi
-- in the package name stands for Choices.
package Sem_Case is
type Choice_Bounds is record
Lo : Node_Id;
Hi : Node_Id;
Node : Node_Id;
end record;
type Choice_Table_Type is array (Pos range <>) of Choice_Bounds;
-- Table type used to sort the choices present in a case statement,
-- array aggregate or record variant.
procedure No_OP (C : Node_Id);
-- The no-operation routine. Does absolutely nothing. Can be used
-- in the following generic for the parameter Proces_Empty_Choice.
generic
with function Get_Alternatives (N : Node_Id) return List_Id;
-- Function needed to get to the actual list of case statement
-- alternatives, or array aggregate component associations or
-- record variants from which we can then access the actual lists
-- of discrete choices. N is the node for the original construct
-- ie a case statement, an array aggregate or a record variant.
with function Get_Choices (A : Node_Id) return List_Id;
-- Given a case statement alternative, array aggregate component
-- association or record variant A we need different access functions
-- to get to the actual list of discrete choices.
with procedure Process_Empty_Choice (Choice : Node_Id);
-- Processing to carry out for an empty Choice.
with procedure Process_Non_Static_Choice (Choice : Node_Id);
-- Processing to carry out for a non static Choice.
with procedure Process_Associated_Node (A : Node_Id);
-- Associated to each case alternative, aggregate component
-- association or record variant A there is a node or list of nodes
-- that need semantic processing. This routine implements that
-- processing.
package Generic_Choices_Processing is
function Number_Of_Choices (N : Node_Id) return Nat;
-- Iterates through the choices of N, (N can be a case statement,
-- array aggregate or record variant), counting all the Choice nodes
-- except for the Others choice.
procedure Analyze_Choices
(N : Node_Id;
Subtyp : Entity_Id;
Choice_Table : in out Choice_Table_Type;
Last_Choice : out Nat;
Raises_CE : out Boolean;
Others_Present : out Boolean);
-- From a case statement, array aggregate or record variant N, this
-- routine analyzes the corresponding list of discrete choices.
-- Subtyp is the subtype of the discrete choices. The type against
-- which the discrete choices must be resolved is its base type.
--
-- On entry Choice_Table must be big enough to contain all the
-- discrete choices encountered.
--
-- On exit Choice_Table contains all the static and non empty
-- discrete choices in sorted order. Last_Choice gives the position
-- of the last valid choice in Choice_Table, Choice_Table'First
-- contains the first. We can have Last_Choice < Choice_Table'Last
-- for one (or several) of the following reasons:
--
-- (a) The list of choices contained a non static choice
--
-- (b) The list of choices contained an empty choice
-- (something like "1 .. 0 => ")
--
-- (c) One of the bounds of a discrete choice contains an
-- error or raises constraint error.
--
-- In one of the bounds of a discrete choice raises a constraint
-- error the flag Raise_CE is set.
--
-- Finally Others_Present is set to True if an Others choice is
-- present in the list of choices.
end Generic_Choices_Processing;
end Sem_Case;
gcc/ada/sem_cat.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ C A T --
-- --
-- S p e c --
-- --
-- $Revision: 1.14 $
-- --
-- Copyright (C) 1992-2000 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This unit contains the routines used for checking for conformance with
-- the semantic restrictions required for the categorization pragmas:
--
-- Preelaborate
-- Pure,
-- Remote_Call_Interface
-- Remote_Types
-- Shared_Passive
--
-- Note that we treat Preelaborate as a categorization pragma, even though
-- strictly, according to RM E.2(2,3), the term does not apply in this case.
with Types; use Types;
package Sem_Cat is
function In_Preelaborated_Unit return Boolean;
-- Determines if the current scope is within a preelaborated compilation
-- unit, that is one to which one of the pragmas Preelaborate, Pure,
-- Shared_Passive, Remote_Types, or inside a unit other than a package
-- body with pragma Remote_Call_Interface.
function In_Pure_Unit return Boolean;
pragma Inline (In_Pure_Unit);
-- Determines if the current scope is within pure compilation unit,
-- that is, one to which the pragmas Pure is applied.
function In_Subprogram_Task_Protected_Unit return Boolean;
-- Determines if the current scope is within a subprogram, task
-- or protected unit. Used to validate if the library unit is Pure
-- (RM 10.2.1(16)).
procedure Set_Categorization_From_Pragmas (N : Node_Id);
-- Since validation of categorization dependency is done during analyze
-- so categorization flags from following pragmas should be set before
-- validation begin. N is the N_Compilation_Unit node.
procedure Validate_Access_Type_Declaration (T : Entity_Id; N : Node_Id);
-- Validate all constraints against declaration of access types in
-- categorized library units. Usually this is a violation in Pure unit,
-- Shared_Passive unit. N is the declaration node.
procedure Validate_Ancestor_Part (N : Node_Id);
-- Checks that a type given as the ancestor in an extension aggregate
-- satisfies the restriction of 10.2.1(9).
procedure Validate_Categorization_Dependency (N : Node_Id; E : Entity_Id);
-- There are restrictions on lib unit that semantically depends on other
-- units (RM E.2(5), 10.2.1(11). This procedure checks the restrictions
-- on categorizations. N is the current unit node, and E is the current
-- library unit entity.
procedure Validate_Controlled_Object (E : Entity_Id);
-- Given an entity for a library level controlled object, check that it is
-- not in a preelaborated unit (prohibited by RM 10.2.1(9)).
procedure Validate_Null_Statement_Sequence (N : Node_Id);
-- Given N, a package body node, check that a handled statement sequence
-- in a preelaborable body contains no statements other than labels or
-- null statements, as required by RM 10.2.1(6).
procedure Validate_Object_Declaration (N : Node_Id);
-- Given N, an object declaration node, validates all the constraints in
-- a preelaborable library unit, including creation of task objects etc.
-- Note that this is called when the corresponding object is frozen since
-- the checks cannot be made before knowing if the object is imported.
procedure Validate_RCI_Declarations (P : Entity_Id);
-- Apply semantic checks given in E2.3(10-14).
procedure Validate_RCI_Subprogram_Declaration (N : Node_Id);
-- Check for RCI unit subprogram declarations with respect to
-- in-lined subprogram and subprogram with access parameter or
-- limited type parameter without Read and Write.
procedure Validate_Remote_Access_To_Class_Wide_Type (N : Node_Id);
-- Checks that Storage_Pool and Storage_Size attribute references are
-- not applied to remote access-to-class-wide types. And the expected
-- type for an allocator shall not be a remote access-to-class-wide
-- type. And a remote access-to-class-wide type shall not be an actual
-- parameter for a generic formal access type. RM E.2.3(22).
procedure Validate_Remote_Access_To_Subprogram_Type (N : Node_Id);
-- Checks that a remote access to subprogram type does not have a
-- parameter of an access type. This is not strictly forbidden at this
-- time, but this is useless, as such a RAS type will not be usable
-- per E.2.2(12) and E.2.3(14).
procedure Validate_RT_RAT_Component (N : Node_Id);
-- Given N, the package library unit declaration node, we should check
-- against RM:9.95 E.2.2(8): the full view of a type declared in the
-- visible part of a Remote Types unit has a part that is of a non-remote
-- access type which has no read/write.
procedure Validate_Remote_Type_Type_Conversion (N : Node_Id);
-- Check for remote-type type conversion constraints. First, a value of
-- a remote access-to-subprogram type can be converted only to another
-- type conformant remote access-to-subprogram type. Secondly, a value
-- of a remote access-to-class-wide type can be converted only to another
-- remote access-to-class-wide type (RM E.2.3(17,20)).
procedure Validate_SP_Access_Object_Type_Decl (T : Entity_Id);
-- Check validity of declaration if shared passive unit. It should not
-- contain the declaration of an access-to-object type whose designated
-- type is a class-wide type ,task type or protected type. E.2.1(7).
-- T is the entity of the declared type.
procedure Validate_Static_Object_Name (N : Node_Id);
-- In the elaboration code of a preelaborated library unit, check
-- that we do not have the evaluation of a primary that is a name of
-- an object, unless the name is a static expression (RM 10.2.1(8)).
-- Non-static constant and variable are the targets, generic parameters
-- are not included because the generic declaration and body are
-- preelaborable.
end Sem_Cat;
gcc/ada/sem_ch10.adb 0 → 100644
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/sem_ch10.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ C H 1 0 --
-- --
-- S p e c --
-- --
-- $Revision: 1.7 $ --
-- --
-- Copyright (C) 1992-2001 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Types; use Types;
package Sem_Ch10 is
procedure Analyze_Compilation_Unit (N : Node_Id);
procedure Analyze_With_Clause (N : Node_Id);
procedure Analyze_With_Type_Clause (N : Node_Id);
procedure Analyze_Subprogram_Body_Stub (N : Node_Id);
procedure Analyze_Package_Body_Stub (N : Node_Id);
procedure Analyze_Task_Body_Stub (N : Node_Id);
procedure Analyze_Protected_Body_Stub (N : Node_Id);
procedure Analyze_Subunit (N : Node_Id);
procedure Install_Context (N : Node_Id);
-- Installs the entities from the context clause of the given compilation
-- unit into the visibility chains. This is done before analyzing a unit.
-- For a child unit, install context of parents as well.
procedure Remove_Context (N : Node_Id);
-- Removes the entities from the context clause of the given compilation
-- unit from the visibility chains. This is done on exit from a unit as
-- part of cleaning up the visibility chains for the caller. A special
-- case is that the call from the Main_Unit can be ignored, since at the
-- end of the main unit the visibility table won't be needed in any case.
-- For a child unit, remove parents and their context as well.
procedure Load_Needed_Body (N : Node_Id; OK : out Boolean);
-- Load and analyze the body of a context unit that is generic, or
-- that contains generic units or inlined units. The body becomes
-- part of the semantic dependency set of the unit that needs it.
-- The returned result in OK is True if the load is successful,
-- and False if the requested file cannot be found.
end Sem_Ch10;
gcc/ada/sem_ch11.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ C H 1 1 --
-- --
-- S p e c --
-- --
-- $Revision: 1.9 $ --
-- --
-- Copyright (C) 1992-1998 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Types; use Types;
package Sem_Ch11 is
procedure Analyze_Exception_Declaration (N : Node_Id);
procedure Analyze_Handled_Statements (N : Node_Id);
procedure Analyze_Raise_Statement (N : Node_Id);
procedure Analyze_Raise_xxx_Error (N : Node_Id);
procedure Analyze_Subprogram_Info (N : Node_Id);
procedure Analyze_Exception_Handlers (L : List_Id);
-- Analyze list of exception handlers of a handled statement sequence
end Sem_Ch11;
gcc/ada/sem_ch12.adb 0 → 100644
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/sem_ch12.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ C H 1 2 --
-- --
-- S p e c --
-- --
-- $Revision: 1.19 $
-- --
-- Copyright (C) 1992-2000 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Inline; use Inline;
with Types; use Types;
package Sem_Ch12 is
procedure Analyze_Generic_Package_Declaration (N : Node_Id);
procedure Analyze_Generic_Subprogram_Declaration (N : Node_Id);
procedure Analyze_Package_Instantiation (N : Node_Id);
procedure Analyze_Procedure_Instantiation (N : Node_Id);
procedure Analyze_Function_Instantiation (N : Node_Id);
procedure Analyze_Formal_Object_Declaration (N : Node_Id);
procedure Analyze_Formal_Type_Declaration (N : Node_Id);
procedure Analyze_Formal_Subprogram (N : Node_Id);
procedure Analyze_Formal_Package (N : Node_Id);
procedure Start_Generic;
-- Must be invoked before starting to process a generic spec or body.
procedure End_Generic;
-- Must be invoked just at the end of the end of the processing of a
-- generic spec or body.
procedure Check_Generic_Child_Unit
(Gen_Id : Node_Id;
Parent_Installed : in out Boolean);
-- If the name of the generic unit in an instantiation or a renaming
-- is a selected component, then the prefix may be an instance and the
-- selector may designate a child unit. Retrieve the parent generic
-- and search for the child unit that must be declared within. Similarly,
-- if this is the name of a generic child unit within an instantiation of
-- its own parent, retrieve the parent generic.
function Copy_Generic_Node
(N : Node_Id;
Parent_Id : Node_Id;
Instantiating : Boolean)
return Node_Id;
-- Copy the tree for a generic unit or its body. The unit is copied
-- repeatedly: once to produce a copy on which semantic analysis of
-- the generic is performed, and once for each instantiation. The tree
-- being copied is not semantically analyzed, except that references to
-- global entities are marked on terminal nodes.
function Get_Instance_Of (A : Entity_Id) return Entity_Id;
-- Retrieve actual associated with given generic parameter.
-- If A is uninstantiated or not a generic parameter, return A.
procedure Instantiate_Package_Body
(Body_Info : Pending_Body_Info);
-- Called after semantic analysis, to complete the instantiation of
-- package instances.
procedure Instantiate_Subprogram_Body
(Body_Info : Pending_Body_Info);
-- Called after semantic analysis, to complete the instantiation of
-- function and procedure instances.
procedure Save_Global_References (N : Node_Id);
-- Traverse the original generic unit, and capture all references to
-- entities that are defined outside of the generic in the analyzed
-- tree for the template. These references are copied into the original
-- tree, so that they appear automatically in every instantiation.
-- A critical invariant in this approach is that if an id in the generic
-- resolves to a local entity, the corresponding id in the instance
-- will resolve to the homologous entity in the instance, even though
-- the enclosing context for resolution is different, as long as the
-- global references have been captured as described here.
-- Because instantiations can be nested, the environment of the instance,
-- involving the actuals and other data-structures, must be saved and
-- restored in stack-like fashion. Front-end inlining also uses these
-- structures for the management of private/full views.
procedure Set_Copied_Sloc (N : Node_Id; E : Entity_Id);
procedure Save_Env
(Gen_Unit : Entity_Id;
Act_Unit : Entity_Id);
procedure Restore_Env;
end Sem_Ch12;
gcc/ada/sem_ch13.adb 0 → 100644
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/sem_ch13.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ C H 1 3 --
-- --
-- S p e c --
-- --
-- $Revision: 1.39 $
-- --
-- Copyright (C) 1992-2001 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Snames; use Snames;
with Types; use Types;
with Uintp; use Uintp;
package Sem_Ch13 is
procedure Analyze_At_Clause (N : Node_Id);
procedure Analyze_Attribute_Definition_Clause (N : Node_Id);
procedure Analyze_Enumeration_Representation_Clause (N : Node_Id);
procedure Analyze_Free_Statement (N : Node_Id);
procedure Analyze_Record_Representation_Clause (N : Node_Id);
procedure Analyze_Code_Statement (N : Node_Id);
procedure Initialize;
-- Initialize internal tables for new compilation
procedure Set_Enum_Esize (T : Entity_Id);
-- This routine sets the Esize field for an enumeration type T, based
-- on the current representation information available for T. Note that
-- the setting of the RM_Size field is not affected. This routine also
-- initializes the alignment field to zero.
function Minimum_Size
(T : Entity_Id;
Biased : Boolean := False)
return Nat;
-- Given a primitive type, determines the minimum number of bits required
-- to represent all values of the type. This function may not be called
-- with any other types. If the flag Biased is set True, then the minimum
-- size calculation that biased representation is used in the case of a
-- discrete type, e.g. the range 7..8 gives a minimum size of 4 with
-- Biased set to False, and 1 with Biased set to True. Note that the
-- biased parameter only has an effect if the type is not biased, it
-- causes Minimum_Size to indicate the minimum size of an object with
-- the given type, of the size the type would have if it were biased. If
-- the type is already biased, then Minimum_Size returns the biased size,
-- regardless of the setting of Biased. Also, fixed-point types are never
-- biased in the current implementation.
procedure Check_Size
(N : Node_Id;
T : Entity_Id;
Siz : Uint;
Biased : out Boolean);
-- Called when size Siz is specified for subtype T. This subprogram checks
-- that the size is appropriate, posting errors on node N as required.
-- For non-elementary types, a check is only made if an explicit size
-- has been given for the type (and the specified size must match). The
-- parameter Biased is set False if the size specified did not require
-- the use of biased representation, and True if biased representation
-- was required to meet the size requirement. Note that Biased is only
-- set if the type is not currently biased, but biasing it is the only
-- way to meet the requirement. If the type is currently biased, then
-- this biased size is used in the initial check, and Biased is False.
function Get_Rep_Pragma (E : Entity_Id; Nam : Name_Id) return Node_Id;
-- Searches the Rep_Item chain for the given entity E, for an instance
-- of a representation pragma with the given name Nam. If found then
-- the value returned is the N_Pragma node, otherwise Empty is returned.
function Get_Attribute_Definition_Clause
(E : Entity_Id;
Id : Attribute_Id)
return Node_Id;
-- Searches the Rep_Item chain for a given entity E, for an instance
-- of an attribute definition clause with the given attibute Id Id. If
-- found, the value returned is the N_Attribute_Definition_Clause node,
-- otherwise Empty is returned.
procedure Record_Rep_Item (T : Entity_Id; N : Node_Id);
-- N is the node for either a representation pragma or an attribute
-- definition clause that applies to type T. This procedure links
-- the node N onto the Rep_Item chain for the type T.
function Rep_Item_Too_Early
(T : Entity_Id;
N : Node_Id)
return Boolean;
-- Called at the start of processing a representation clause or a
-- representation pragma. Used to check that the representation item
-- is not being applied to an incompleted type or to a generic formal
-- type or a type derived from a generic formal type. Returns False if
-- no such error occurs. If this error does occur, appropriate error
-- messages are posted on node N, and True is returned.
function Rep_Item_Too_Late
(T : Entity_Id;
N : Node_Id;
FOnly : Boolean := False)
return Boolean;
-- Called at the start of processing a representation clause or a
-- representation pragma. Used to check that a representation item
-- for entity T does not appear too late (according to the rules in
-- RM 13.1(9) and RM 13.1(10)). N is the associated node, which in
-- the pragma case is the pragma or representation clause itself, used
-- for placing error messages if the item is too late.
--
-- Fonly is a flag that causes only the freezing rule (para 9) to be
-- applied, and the tests of para 10 are skipped. This is appropriate
-- for both subtype related attributes (Alignment and Size) and for
-- stream attributes, which, although certainly not subtype related
-- attributes, clearly should not be subject to the para 10 restrictions
-- (see AI95-00137). Similarly, we also skip the para 10 restrictions for
-- the Storage_Size case where they also clearly do not apply.
--
-- If the rep item is too late, an appropriate message is output and
-- True is returned, which is a signal that the caller should abandon
-- processing for the item. If the item is not too late, then False
-- is returned, and the caller can continue processing the item.
--
-- If no error is detected, this call also as a side effect links the
-- representation item onto the head of the representation item chain
-- (referenced by the First_Rep_Item field of the entity).
--
-- Note: Rep_Item_Too_Late must be called with the underlying type in
-- the case of a private or incomplete type. The protocol is to first
-- check for Rep_Item_Too_Early using the initial entity, then take the
-- underlying type, then call Rep_Item_Too_Late on the result.
function Same_Representation (Typ1, Typ2 : Entity_Id) return Boolean;
-- Given two types, where the two types are related by possible derivation,
-- determines if the two types have the same representation, or different
-- representations, requiring the special processing for representation
-- change. A False result is possible only for array, enumeration or
-- record types.
procedure Validate_Unchecked_Conversion
(N : Node_Id;
Act_Unit : Entity_Id);
-- Validate a call to unchecked conversion. N is the node for the actual
-- instantiation, which is used only for error messages. Act_Unit is the
-- entity for the instantiation, from which the actual types etc for this
-- instantiation can be determined. This procedure makes an entry in a
-- table and/or generates an N_Validate_Unchecked_Conversion node. The
-- actual checking is done in Validate_Unchecked_Conversions or in the
-- back end as required.
procedure Validate_Unchecked_Conversions;
-- This routine is called after calling the backend to validate
-- unchecked conversions for size and alignment appropriateness.
-- The reason it is called that late is to take advantage of any
-- back-annotation of size and alignment performed by the backend.
end Sem_Ch13;
gcc/ada/sem_ch2.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ C H 2 --
-- --
-- B o d y --
-- --
-- $Revision: 1.8 $ --
-- --
-- Copyright (C) 1992-1999, 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Atree; use Atree;
with Opt; use Opt;
with Restrict; use Restrict;
with Sem_Ch8; use Sem_Ch8;
with Sinfo; use Sinfo;
with Stand; use Stand;
package body Sem_Ch2 is
-------------------------------
-- Analyze_Character_Literal --
-------------------------------
procedure Analyze_Character_Literal (N : Node_Id) is
begin
-- The type is eventually inherited from the context. If expansion
-- has already established the proper type, do not modify it.
if No (Etype (N)) then
Set_Etype (N, Any_Character);
end if;
Set_Is_Static_Expression (N);
if Comes_From_Source (N)
and then not In_Character_Range (Char_Literal_Value (N))
then
Check_Restriction (No_Wide_Characters, N);
end if;
end Analyze_Character_Literal;
------------------------
-- Analyze_Identifier --
------------------------
procedure Analyze_Identifier (N : Node_Id) is
begin
Find_Direct_Name (N);
end Analyze_Identifier;
-----------------------------
-- Analyze_Integer_Literal --
-----------------------------
procedure Analyze_Integer_Literal (N : Node_Id) is
begin
Set_Etype (N, Universal_Integer);
Set_Is_Static_Expression (N);
end Analyze_Integer_Literal;
--------------------------
-- Analyze_Real_Literal --
--------------------------
procedure Analyze_Real_Literal (N : Node_Id) is
begin
Set_Etype (N, Universal_Real);
Set_Is_Static_Expression (N);
end Analyze_Real_Literal;
----------------------------
-- Analyze_String_Literal --
----------------------------
procedure Analyze_String_Literal (N : Node_Id) is
begin
-- The type is eventually inherited from the context. If expansion
-- has already established the proper type, do not modify it.
if No (Etype (N)) then
Set_Etype (N, Any_String);
end if;
-- String literals are static in Ada 95. Note that if the subtype
-- turns out to be non-static, then the Is_Static_Expression flag
-- will be reset in Eval_String_Literal.
if Ada_95 then
Set_Is_Static_Expression (N);
end if;
if Comes_From_Source (N) and then Has_Wide_Character (N) then
Check_Restriction (No_Wide_Characters, N);
end if;
end Analyze_String_Literal;
end Sem_Ch2;
gcc/ada/sem_ch2.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ C H 2 --
-- --
-- S p e c --
-- --
-- $Revision: 1.3 $ --
-- --
-- Copyright (C) 1992-1998, 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Types; use Types;
package Sem_Ch2 is
procedure Analyze_Character_Literal (N : Node_Id);
procedure Analyze_Identifier (N : Node_Id);
procedure Analyze_Integer_Literal (N : Node_Id);
procedure Analyze_Real_Literal (N : Node_Id);
procedure Analyze_String_Literal (N : Node_Id);
private
pragma Inline (Analyze_Character_Literal);
pragma Inline (Analyze_Identifier);
pragma Inline (Analyze_Integer_Literal);
pragma Inline (Analyze_Real_Literal);
pragma Inline (Analyze_String_Literal);
end Sem_Ch2;
gcc/ada/sem_ch3.adb 0 → 100644
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/sem_ch4.adb 0 → 100644
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/sem_ch4.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ C H 4 --
-- --
-- S p e c --
-- --
-- $Revision: 1.18 $ --
-- --
-- Copyright (C) 1992,1993,1994,1995,1996 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Types; use Types;
package Sem_Ch4 is
procedure Analyze_Aggregate (N : Node_Id);
procedure Analyze_Allocator (N : Node_Id);
procedure Analyze_Arithmetic_Op (N : Node_Id);
procedure Analyze_Call (N : Node_Id);
procedure Analyze_Comparison_Op (N : Node_Id);
procedure Analyze_Concatenation (N : Node_Id);
procedure Analyze_Conditional_Expression (N : Node_Id);
procedure Analyze_Equality_Op (N : Node_Id);
procedure Analyze_Explicit_Dereference (N : Node_Id);
procedure Analyze_Logical_Op (N : Node_Id);
procedure Analyze_Membership_Op (N : Node_Id);
procedure Analyze_Negation (N : Node_Id);
procedure Analyze_Null (N : Node_Id);
procedure Analyze_Qualified_Expression (N : Node_Id);
procedure Analyze_Range (N : Node_Id);
procedure Analyze_Reference (N : Node_Id);
procedure Analyze_Selected_Component (N : Node_Id);
procedure Analyze_Short_Circuit (N : Node_Id);
procedure Analyze_Slice (N : Node_Id);
procedure Analyze_Type_Conversion (N : Node_Id);
procedure Analyze_Unary_Op (N : Node_Id);
procedure Analyze_Unchecked_Expression (N : Node_Id);
procedure Analyze_Unchecked_Type_Conversion (N : Node_Id);
procedure Analyze_Indexed_Component_Form (N : Node_Id);
-- Prior to semantic analysis, an indexed component node can denote any
-- of the following syntactic constructs:
-- a) An indexed component of an array
-- b) A function call
-- c) A conversion
-- d) A slice
-- The resolution of the construct requires some semantic information
-- on the prefix and the indices.
end Sem_Ch4;
gcc/ada/sem_ch5.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ C H 5 --
-- --
-- S p e c --
-- --
-- $Revision: 1.16 $ --
-- --
-- Copyright (C) 1992-1998 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Types; use Types;
package Sem_Ch5 is
procedure Analyze_Assignment (N : Node_Id);
procedure Analyze_Block_Statement (N : Node_Id);
procedure Analyze_Case_Statement (N : Node_Id);
procedure Analyze_Exit_Statement (N : Node_Id);
procedure Analyze_Goto_Statement (N : Node_Id);
procedure Analyze_If_Statement (N : Node_Id);
procedure Analyze_Implicit_Label_Declaration (N : Node_Id);
procedure Analyze_Label (N : Node_Id);
procedure Analyze_Loop_Statement (N : Node_Id);
procedure Analyze_Null_Statement (N : Node_Id);
procedure Analyze_Statements (L : List_Id);
procedure Analyze_Label_Entity (E : Entity_Id);
-- This procedure performs direct analysis of the label entity E. It
-- is used when a label is created by the expander without bothering
-- to insert an N_Implicit_Label_Declaration in the tree. It also takes
-- care of setting Reachable, since labels defined by the expander can
-- be assumed to be reachable.
procedure Check_Unreachable_Code (N : Node_Id);
-- This procedure is called with N being the node for a statement that
-- is an unconditional transfer of control. It checks to see if the
-- statement is followed by some other statement, and if so generates
-- an appropriate warning for unreachable code.
end Sem_Ch5;
gcc/ada/sem_ch6.adb 0 → 100644
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/sem_ch6.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ C H 6 --
-- --
-- S p e c --
-- --
-- $Revision: 1.22 $ --
-- --
-- Copyright (C) 1992,1993,1994,1995,1996 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Types; use Types;
package Sem_Ch6 is
procedure Analyze_Abstract_Subprogram_Declaration (N : Node_Id);
procedure Analyze_Function_Call (N : Node_Id);
procedure Analyze_Operator_Symbol (N : Node_Id);
procedure Analyze_Parameter_Association (N : Node_Id);
procedure Analyze_Procedure_Call (N : Node_Id);
procedure Analyze_Return_Statement (N : Node_Id);
procedure Analyze_Subprogram_Declaration (N : Node_Id);
procedure Analyze_Subprogram_Body (N : Node_Id);
function Analyze_Spec (N : Node_Id) return Entity_Id;
-- Analyze subprogram specification in both subprogram declarations
-- and body declarations.
procedure Check_Delayed_Subprogram (Designator : Entity_Id);
-- Designator can be a E_Subrpgram_Type, E_Procedure or E_Function. If a
-- type in its profile depends on a private type without a full
-- declaration, indicate that the subprogram is delayed.
procedure Check_Discriminant_Conformance
(N : Node_Id;
Prev : Entity_Id;
Prev_Loc : Node_Id);
-- Check that the discriminants of a full type N fully conform to
-- the discriminants of the corresponding partial view Prev.
-- Prev_Loc indicates the source location of the partial view,
-- which may be different than Prev in the case of private types.
procedure Check_Fully_Conformant
(New_Id : Entity_Id;
Old_Id : Entity_Id;
Err_Loc : Node_Id := Empty);
-- Check that two callable entitites (subprograms, entries, literals)
-- are fully conformant, post error message if not (RM 6.3.1(17)) with
-- the flag being placed on the Err_Loc node if it is specified, and
-- on the appropriate component of the New_Id construct if not. Note:
-- when checking spec/body conformance, New_Id must be the body entity
-- and Old_Id is the spec entity (the code in the implementation relies
-- on this ordering, and in any case, this makes sense, since if flags
-- are to be placed on the construct, they clearly belong on the body.
procedure Check_Mode_Conformant
(New_Id : Entity_Id;
Old_Id : Entity_Id;
Err_Loc : Node_Id := Empty;
Get_Inst : Boolean := False);
-- Check that two callable entitites (subprograms, entries, literals)
-- are mode conformant, post error message if not (RM 6.3.1(15)) with
-- the flag being placed on the Err_Loc node if it is specified, and
-- on the appropriate component of the New_Id construct if not. The
-- argument Get_Inst is set to True when this is a check against a
-- formal access-to-subprogram type, indicating that mapping of types
-- is needed.
procedure Check_Subtype_Conformant
(New_Id : Entity_Id;
Old_Id : Entity_Id;
Err_Loc : Node_Id := Empty);
-- Check that two callable entitites (subprograms, entries, literals)
-- are subtype conformant, post error message if not (RM 6.3.1(16))
-- the flag being placed on the Err_Loc node if it is specified, and
-- on the appropriate component of the New_Id construct if not.
procedure Check_Type_Conformant
(New_Id : Entity_Id;
Old_Id : Entity_Id;
Err_Loc : Node_Id := Empty);
-- Check that two callable entitites (subprograms, entries, literals)
-- are type conformant, post error message if not (RM 6.3.1(14)) with
-- the flag being placed on the Err_Loc node if it is specified, and
-- on the appropriate component of the New_Id construct if not.
procedure Create_Extra_Formals (E : Entity_Id);
-- For each parameter of a subprogram or entry that requires an additional
-- formal (such as for access parameters and indefinite discriminated
-- parameters), creates the appropriate formal and attach it to its
-- associated parameter. Each extra formal will also be appended to
-- the end of Subp's parameter list (with each subsequent extra formal
-- being attached to the preceding extra formal).
function Find_Corresponding_Spec (N : Node_Id) return Entity_Id;
-- Use the subprogram specification in the body to retrieve the previous
-- subprogram declaration, if any.
function Fully_Conformant (New_Id, Old_Id : Entity_Id) return Boolean;
-- Determine whether two callable entities (subprograms, entries,
-- literals) are fully conformant (RM 6.3.1(17))
function Fully_Conformant_Expressions
(Given_E1 : Node_Id;
Given_E2 : Node_Id)
return Boolean;
-- Determines if two (non-empty) expressions are fully conformant
-- as defined by (RM 6.3.1(18-21))
function Mode_Conformant (New_Id, Old_Id : Entity_Id) return Boolean;
-- Determine whether two callable entities (subprograms, entries,
-- literals) are mode conformant (RM 6.3.1(15))
procedure New_Overloaded_Entity
(S : Entity_Id;
Derived_Type : Entity_Id := Empty);
-- Process new overloaded entity. Overloaded entities are created
-- by enumeration type declarations, subprogram specifications,
-- entry declarations, and (implicitly) by type derivations.
-- If Derived_Type is not Empty, then it indicates that this
-- is subprogram derived for that type.
procedure Process_Formals (
S : Entity_Id;
T : List_Id;
Related_Nod : Node_Id);
-- Enter the formals in the scope of the subprogram or entry, and
-- analyze default expressions if any. The implicit types created for
-- access parameter are attached to the Related_Nod which comes from the
-- context.
procedure Set_Actual_Subtypes (N : Node_Id; Subp : Entity_Id);
-- If the formals of a subprogram are unconstrained, build a subtype
-- declaration that uses the bounds or discriminants of the actual to
-- construct an actual subtype for them. This is an optimization that
-- is done only in some cases where the actual subtype cannot change
-- during execution of the subprogram. By setting the actual subtype
-- once, we avoid recomputing it unnecessarily.
procedure Set_Formal_Mode (Formal_Id : Entity_Id);
-- Set proper Ekind to reflect formal mode (in, out, in out)
function Subtype_Conformant (New_Id, Old_Id : Entity_Id) return Boolean;
-- Determine whether two callable entities (subprograms, entries,
-- literals) are subtype conformant (RM6.3.1(16))
function Type_Conformant (New_Id, Old_Id : Entity_Id) return Boolean;
-- Determine whether two callable entities (subprograms, entries,
-- literals) are type conformant (RM6.3.1(14))
procedure Valid_Operator_Definition (Designator : Entity_Id);
-- Verify that an operator definition has the proper number of formals
end Sem_Ch6;
gcc/ada/sem_ch7.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ C H 7 --
-- --
-- S p e c --
-- --
-- $Revision: 1.19 $ --
-- --
-- Copyright (C) 1992,1993,1994 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Types; use Types;
package Sem_Ch7 is
procedure Analyze_Package_Body (N : Node_Id);
procedure Analyze_Package_Declaration (N : Node_Id);
procedure Analyze_Package_Specification (N : Node_Id);
procedure Analyze_Private_Type_Declaration (N : Node_Id);
procedure End_Package_Scope (P : Entity_Id);
-- Calls Uninstall_Declarations, and then pops the scope stack.
procedure Exchange_Declarations (Id : Entity_Id);
-- Exchange private and full declaration on entry/exit from a package
-- declaration or body. The semantic links of the respective nodes
-- are preserved in the exchange.
procedure Install_Visible_Declarations (P : Entity_Id);
procedure Install_Private_Declarations (P : Entity_Id);
-- On entrance to a package body, make declarations in package spec
-- immediately visible.
-- When compiling the body of a package, both routines are called in
-- succession. When compiling the body of a child package, the call
-- to Install_Private_Declaration is immediate for private children,
-- but is deffered until the compilation of the private part of the
-- child for public child packages.
procedure Install_Package_Entity (Id : Entity_Id);
-- Basic procedure for the previous two. Places one entity on its
-- visibility chain, and recurses on the visible part if the entity
-- is an inner package.
function Unit_Requires_Body (P : Entity_Id) return Boolean;
-- Check if a unit requires a body. A specification requires a body
-- if it contains declarations that require completion in a body.
procedure May_Need_Implicit_Body (E : Entity_Id);
-- If a package declaration contains tasks and does not require a
-- body, create an implicit body at the end of the current declarative
-- part to activate those tasks.
function Is_Fully_Visible (Type_Id : Entity_Id) return Boolean;
-- Indicates whether the Full Declaration of a private type is visible.
procedure New_Private_Type (N : Node_Id; Id : Entity_Id; Def : Node_Id);
-- Common processing for private type declarations and for formal
-- private type declarations. For private types, N and Def are the type
-- declaration node; for formal private types, Def is the formal type
-- definition.
procedure Uninstall_Declarations (P : Entity_Id);
-- At the end of a package declaration or body, declarations in the
-- visible part are no longer immediately visible, and declarations in
-- the private part are not visible at all. For inner packages, place
-- visible entities at the end of their homonym chains. For compilation
-- units, make all entities invisible. In both cases, exchange private
-- and visible declarations to restore order of elaboration.
end Sem_Ch7;
gcc/ada/sem_ch8.adb 0 → 100644
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/sem_ch9.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ C H 9 --
-- --
-- S p e c --
-- --
-- $Revision: 1.8 $
-- --
-- Copyright (C) 1992-2001 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Types; use Types;
package Sem_Ch9 is
procedure Analyze_Abort_Statement (N : Node_Id);
procedure Analyze_Accept_Alternative (N : Node_Id);
procedure Analyze_Accept_Statement (N : Node_Id);
procedure Analyze_Asynchronous_Select (N : Node_Id);
procedure Analyze_Conditional_Entry_Call (N : Node_Id);
procedure Analyze_Delay_Alternative (N : Node_Id);
procedure Analyze_Delay_Relative (N : Node_Id);
procedure Analyze_Delay_Until (N : Node_Id);
procedure Analyze_Entry_Body (N : Node_Id);
procedure Analyze_Entry_Body_Formal_Part (N : Node_Id);
procedure Analyze_Entry_Call_Alternative (N : Node_Id);
procedure Analyze_Entry_Declaration (N : Node_Id);
procedure Analyze_Entry_Index_Specification (N : Node_Id);
procedure Analyze_Protected_Body (N : Node_Id);
procedure Analyze_Protected_Definition (N : Node_Id);
procedure Analyze_Protected_Type (N : Node_Id);
procedure Analyze_Requeue (N : Node_Id);
procedure Analyze_Selective_Accept (N : Node_Id);
procedure Analyze_Single_Protected (N : Node_Id);
procedure Analyze_Single_Task (N : Node_Id);
procedure Analyze_Task_Body (N : Node_Id);
procedure Analyze_Task_Definition (N : Node_Id);
procedure Analyze_Task_Type (N : Node_Id);
procedure Analyze_Terminate_Alternative (N : Node_Id);
procedure Analyze_Timed_Entry_Call (N : Node_Id);
procedure Analyze_Triggering_Alternative (N : Node_Id);
end Sem_Ch9;
gcc/ada/sem_disp.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ D I S P --
-- --
-- S p e c --
-- --
-- $Revision: 1.16 $ --
-- --
-- Copyright (C) 1992-1999 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package contains routines involved in tagged types and dynamic
-- dispatching.
with Types; use Types;
package Sem_Disp is
procedure Check_Controlling_Formals (Typ : Entity_Id; Subp : Entity_Id);
-- Check that all controlling parameters of Subp are of type Typ,
-- that defaults for controlling parameters are tag-indeterminate,
-- and that the nominal subtype of the parameters and result
-- statically match the first subtype of the controlling type.
procedure Check_Dispatching_Call (N : Node_Id);
-- Check if a call is a dispatching call. The subprogram is known to
-- be a dispatching operation. The call is dispatching if all the
-- controlling actuals are dynamically tagged. This procedure is called
-- after overload resolution, so the call is known to be unambiguous.
procedure Check_Dispatching_Operation (Subp, Old_Subp : Entity_Id);
-- Add "Subp" to the list of primitive operations of the corresponding type
-- if it has a parameter of this type and is defined at a proper place for
-- primitive operations. (new primitives are only defined in package spec,
-- overridden operation can be defined in any scope). If Old_Subp is not
-- Empty we are in the overriding case.
procedure Check_Operation_From_Incomplete_Type
(Subp : Entity_Id;
Typ : Entity_Id);
-- If a primitive operation was defined for the incomplete view of the
-- type, and the full type declaration is a derived type definition,
-- the operation may override an inherited one.
procedure Check_Operation_From_Private_View (Subp, Old_Subp : Entity_Id);
-- Add "Old_Subp" to the list of primitive operations of the corresponding
-- tagged type if it is the full view of a private tagged type. The Alias
-- of "OldSubp" is adjusted to point to the inherited procedure of the
-- full view because it is always this one which has to be called.
function Find_Controlling_Arg (N : Node_Id) return Node_Id;
-- Returns the actual controlling argument if N is dynamically tagged,
-- and Empty if it is not dynamically tagged.
function Find_Dispatching_Type (Subp : Entity_Id) return Entity_Id;
-- Check whether a subprogram is dispatching, and find the tagged
-- type of the controlling argument or arguments.
function Is_Dynamically_Tagged (N : Node_Id) return Boolean;
-- Used to determine whether a call is dispatching, i.e. if is an
-- an expression of a class_Wide type, or a call to a function with
-- controlling result where at least one operand is dynamically tagged.
function Is_Tag_Indeterminate (N : Node_Id) return Boolean;
-- An expression is tag-indeterminate if it is a call that dispatches
-- on result, and all controlling operands are also indeterminate.
-- Such a function call may inherit a tag from an enclosing call.
procedure Propagate_Tag (Control : Node_Id; Actual : Node_Id);
-- If a function call is tag-indeterminate, its controlling argument is
-- found in the context; either an enclosing call, or the left-hand side
-- of the enclosing assignment statement. The tag must be propagated
-- recursively to the tag-indeterminate actuals of the call.
end Sem_Disp;
gcc/ada/sem_dist.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ D I S T --
-- --
-- S p e c --
-- --
-- $Revision: 1.56 $
-- --
-- Copyright (C) 1992-2000 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- Semantic processing for distribution annex facilities
with Types; use Types;
package Sem_Dist is
procedure Add_Stub_Constructs (N : Node_Id);
-- Create the stubs constructs for a remote call interface package
-- specification or body or for a shared passive specification. For
-- caller stubs, expansion takes place directly in the specification and
-- no additional compilation unit is created.
function Is_All_Remote_Call (N : Node_Id) return Boolean;
-- Check whether a function or procedure call should be expanded into
-- a remote call, because the entity is declared in a package decl that
-- is not currently in scope, and the proper pragmas apply.
procedure Process_Partition_Id (N : Node_Id);
-- Replace attribute reference with call to runtime function. The result
-- is converted to the context type, because the attribute yields a
-- universal integer value.
procedure Process_Remote_AST_Attribute (N : Node_Id; New_Type : Entity_Id);
-- Given N, an access attribute reference node whose prefix is a
-- remote subprogram, rewrite N with a call to a conversion function
-- whose return type is New_Type.
procedure Process_Remote_AST_Declaration (N : Node_Id);
-- Given N, an access to subprogram type declaration node in RCI or
-- remote types unit, build a new record (fat pointer) type declaration
-- using the old Defining_Identifier of N and a link to the old
-- declaration node N whose Defining_Identifier is changed.
-- We also construct declarations of two subprograms in the unit
-- specification which handle remote access to subprogram type
-- (fat pointer) dereference and the unit receiver that handles
-- remote calls (from remote access to subprogram type values.)
function Remote_AST_E_Dereference (P : Node_Id) return Boolean;
-- If the prefix of an explicit dereference is a record type that
-- represent the fat pointer for an Remote access to subprogram, in
-- the context of a call, rewrite the enclosing call node into a
-- remote call, the first actual of which is the fat pointer. Return
-- true if the context is correct and the transformation took place.
function Remote_AST_I_Dereference (P : Node_Id) return Boolean;
-- If P is a record type that represents the fat pointer for a remote
-- access to subprogram, and P is the prefix of a call, insert an
-- explicit dereference and perform the transformation described for
-- the previous function.
function Remote_AST_Null_Value
(N : Node_Id;
Typ : Entity_Id)
return Boolean;
-- If N is a null value and Typ a remote access to subprogram type,
-- this function will check if null needs to be replaced with an
-- aggregate and will return True in this case. Otherwise, it will
-- return False.
function Get_Subprogram_Id (E : Entity_Id) return Int;
-- Given a subprogram defined in a RCI package, get its subprogram id
-- which will be used for remote calls.
function Package_Specification_Of_Scope (E : Entity_Id) return Node_Id;
-- Return the N_Package_Specification corresponding to a scope E
end Sem_Dist;
gcc/ada/sem_elab.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ E L A B --
-- --
-- S p e c --
-- --
-- $Revision: 1.8 $
-- --
-- Copyright (C) 1997-2001 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package contains the routines used to deal with issuing warnings
-- for cases of calls that may require warnings about possible access
-- before elaboration.
with Types; use Types;
package Sem_Elab is
-----------------------------
-- Description of Approach --
-----------------------------
-- Every non-static call that is encountered by Sem_Res results in
-- a call to Check_Elab_Call, with N being the call node, and Outer
-- set to its default value of True.
-- The goal of Check_Elab_Call is to determine whether or not the
-- call in question can generate an access before elaboration
-- error (raising Program_Error) either by directly calling a
-- subprogram whose body has not yet been elaborated, or indirectly,
-- by calling a subprogram whose body has been elaborated, but which
-- contains a call to such a subprogram.
-- The only calls that we need to look at at the outer level are
-- calls that occur in elaboration code. There are two cases. The
-- call can be at the outer level of elaboration code, or it can
-- be within another unit, e.g. the elaboration code of a subprogram.
-- In the case of an elaboration call at the outer level, we must
-- trace all calls to outer level routines either within the current
-- unit or to other units that are with'ed. For calls within the
-- current unit, we can determine if the body has been elaborated
-- or not, and if it has not, then a warning is generated.
-- Note that there are two subcases. If the original call directly
-- calls a subprogram whose body has not been elaborated, then we
-- know that an ABE will take place, and we replace the call by
-- a raise of Program_Error. If the call is indirect, then we don't
-- know that the PE will be raised, since the call might be guarded
-- by a conditional. In this case we set Do_Elab_Check on the call
-- so that a dynamic check is generated, and output a warning.
-- For calls to a subprogram in a with'ed unit, we require that
-- a pragma Elaborate_All or pragma Elaborate be present, or that
-- the referenced unit have a pragma Preelaborate, pragma Pure, or
-- pragma Elaborate_Body. If none of these conditions is met, then
-- a warning is generated that a pragma Elaborate_All may be needed.
-- For the case of an elaboration call at some inner level, we are
-- interested in tracing only calls to subprograms at the same level,
-- i.e. those that can be called during elaboration. Any calls to
-- outer level routines cannot cause ABE's as a result of the original
-- call (there might be an outer level call to the subprogram from
-- outside that causes the ABE, but that gets analyzed separately).
-- Note that we never trace calls to inner level subprograms, since
-- these cannot result in ABE's unless there is an elaboration problem
-- at a lower level, which will be separately detected.
-- Note on pragma Elaborate. The checking here assumes that a pragma
-- Elaborate on a with'ed unit guarantees that subprograms within the
-- unit can be called without causing an ABE. This is not in fact the
-- case since pragma Elaborate does not guarantee the transititive
-- coverage guaranteed by Elaborate_All. However, we leave this issue
-- up to the binder, which has generates warnings if there are possible
-- problems in the use of pragma Elaborate.
--------------------------------------
-- Instantiation Elaboration Errors --
--------------------------------------
-- A special case arises when an instantiation appears in a context
-- that is known to be before the body is elaborated, e.g.
-- generic package x is ...
-- ...
-- package xx is new x;
-- ...
-- package body x is ...
-- In this situation it is certain that an elaboration error will
-- occur, and an unconditional raise Program_Error statement is
-- inserted before the instantiation, and a warning generated.
-- The problem is that in this case we have no place to put the
-- body of the instantiation. We can't put it in the normal place,
-- because it is too early, and will cause errors to occur as a
-- result of referencing entities before they are declared.
-- Our approach in this case is simply to avoid creating the body
-- of the instantiation in such a case. The instantiation spec is
-- modified to include dummy bodies for all subprograms, so that
-- the resulting code does not contain subprogram specs with no
-- corresponding bodies.
procedure Check_Elab_Call (N : Node_Id; Outer_Scope : Entity_Id := Empty);
-- Check a call for possible elaboration problems. N is either an
-- N_Function_Call or N_Procedure_Call_Statement node, and Outer
-- indicates whether this is an outer level call from Sem_Res
-- (Outer_Scope set to Empty), or an internal recursive call
-- (Outer_Scope set to entity of outermost call, see body).
procedure Check_Elab_Calls;
-- Not all the processing for Check_Elab_Call can be done at the time
-- of calls to Check_Elab_Call. This is because for internal calls, we
-- need to wait to complete the check until all generic bodies have been
-- instantiated. The Check_Elab_Calls procedure cleans up these waiting
-- checks. It is called once after the completion of instantiation.
procedure Check_Elab_Instantiation
(N : Node_Id;
Outer_Scope : Entity_Id := Empty);
-- Check an instantiation for possible elaboration problems. N is an
-- instantiation node (N_Package_Instantiation, N_Function_Instantiation,
-- or N_Procedure_Instantiation), and Outer_Scope indicates if this is
-- an outer level call from Sem_Ch12 (Outer_Scope set to Empty), or an
-- internal recursive call (Outer_Scope set to scope of outermost call,
-- see body for further details). The returned value is relevant only
-- for an outer level call, and is set to False if an elaboration error
-- is bound to occur on the instantiation, and True otherwise. This is
-- used by the caller to signal that the body of the instance should
-- not be generated (see detailed description in body).
procedure Check_Task_Activation (N : Node_Id);
-- at the point at which tasks are activated in a package body, check
-- that the bodies of the tasks are elaborated.
end Sem_Elab;
gcc/ada/sem_elim.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ E L I M --
-- --
-- S p e c --
-- --
-- $Revision: 1.1 $ --
-- --
-- Copyright (C) 1997 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package contains the routines used to process the Eliminate pragma
with Types; use Types;
package Sem_Elim is
procedure Initialize;
-- Initialize for new main souce program
procedure Process_Eliminate_Pragma
(Arg_Unit_Name : Node_Id;
Arg_Entity : Node_Id;
Arg_Parameter_Types : Node_Id;
Arg_Result_Type : Node_Id);
-- Process eliminate pragma. The number of arguments has been checked,
-- as well as possible optional identifiers, but no other checks have
-- been made. This subprogram completes the checking, and then if the
-- pragma is well formed, makes appropriate entries in the internal
-- tables used to keep track of Eliminate pragmas. The four arguments
-- are the possible pragma arguments (set to Empty if not present).
procedure Check_Eliminated (E : Entity_Id);
-- Checks if entity E is eliminated, and if so sets the Is_Eliminated
-- flag on the given entity.
end Sem_Elim;
gcc/ada/sem_eval.adb 0 → 100644
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/sem_intr.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ I N T R --
-- --
-- S p e c --
-- --
-- $Revision: 1.4 $ --
-- --
-- Copyright (C) 1992,1993,1994 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- Processing for intrinsic subprogram declarations
with Types; use Types;
package Sem_Intr is
procedure Check_Intrinsic_Call (N : Node_Id);
-- Perform legality check for intrinsic call N (which is either function
-- call or a procedure call node). All the normal semantic checks have
-- been performed already. Check_Intrinsic_Call applies any additional
-- checks required by the fact that an intrinsic subprogram is involved.
procedure Check_Intrinsic_Subprogram (E : Entity_Id; N : Node_Id);
-- Special processing for pragma Import or pragma Interface when the
-- convention is Intrinsic. E is the Entity_Id of the spec of the
-- subprogram, and N is the second (subprogram) argument of the pragma.
-- Check_Intrinsic_Subprogram checks that the referenced subprogram is
-- known as an intrinsic and has an appropriate profile. If so the flag
-- Is_Intrinsic_Subprogram is set, otherwise an error message is posted.
end Sem_Intr;
gcc/ada/sem_maps.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ M A P S --
-- --
-- S p e c --
-- --
-- $Revision: 1.4 $
-- --
-- Copyright (C) 1996-1999 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package contains the operations on the renaming maps used for
-- generic analysis and instantiation. Renaming maps are created when
-- a generic unit is analyzed, in order to capture all references to
-- global variables within the unit. The renaming map of a generic unit
-- copied prior to each instantiation, and then updated by mapping the
-- formals into the actuals and the local entities into entities local to
-- the instance. When the generic tree is copied to produce the instance,
-- all references are updated by means of the renaming map.
-- Map composition of renaming maps takes place for nested instantiations,
-- for generic child units, and for formal packages.
-- For additional details, see the documentation in sem_ch12.
with Table;
with Types; use Types;
package Sem_Maps is
type Map is new Int;
type Assoc is private;
type Scope_Kind is (S_Global, S_Formal, S_Local);
function New_Map (Num_Assoc : Int) return Map;
-- Build empty map with the given number of associations, and a
-- headers table of the appropriate size.
function Compose (Orig_Map : Map; New_Map : Map) return Map;
-- Update the associations in Orig_Map, so that if Orig_Map (e1) = e2
-- and New_Map (e2) = e3, then the image of e1 under the result is e3.
function Copy (M : Map) return Map;
-- Full copy of contents and headers.
function Lookup (M : Map; E : Entity_Id) return Entity_Id;
-- Retrieve image of E under M, Empty if undefined.
procedure Add_Association
(M : in out Map;
O_Id : Entity_Id;
N_Id : Entity_Id;
Kind : Scope_Kind := S_Local);
-- Update M in place. On entry M (O_Id) must not be defined.
procedure Update_Association
(M : in out Map;
O_Id : Entity_Id;
N_Id : Entity_Id;
Kind : Scope_Kind := S_Local);
-- Update the entry in M for O_Id.
function Build_Instance_Map (M : Map) return Map;
-- Copy renaming map of generic, and create new entities for all the
-- local entities within.
private
-- New maps are created when a generic is analyzed, and for each of
-- its instantiations. Maps are also updated for nested generics, for
-- child units, and for formal packages. As a result we need to allocate
-- maps dynamically.
-- When analyzing a generic, we do not know how many references are
-- in it. We build an initial map after generic analysis, using a static
-- structure that relies on the compiler's extensible table mechanism.
-- After constructing this initial map, all subsequent uses and updates
-- of this map do not modify its domain, so that dynamically allocated
-- maps have a fixed size and never need to be reallocated. Furthermore,
-- the headers of the hash table of a dynamically allocated map can be
-- chosen according to the total number of entries in the map, to
-- accomodate efficiently generic units of different sizes (Unchecked_
-- Conversion vs. Generic_Elementary_Functions, for example). So in
-- fact both components of a map have fixed size, and can be allocated
-- using the standard table mechanism. A Maps_Table holds records that
-- contain indices into the global Headers table and the Associations
-- table, and a Map is an index into the Maps_Table.
--
-- Maps_Table Headers_Table Associations_Table
--
-- |_____| |___________ |
-- |_____| | | | |
-- ------>|Map |------------------------------>|Associations|
-- |Info |------------->| |=========>| for one |
-- |_____| | |====| | unit |
-- | | | | |====>| |
-- |_____| |____________|
-- | | | |
type Header_Index is new Int;
type Assoc_Index is new Int;
No_Assoc : constant Assoc_Index := -1;
type Map_Info is record
Header_Offset : Header_Index;
Header_Num : Header_Index;
Assoc_Offset : Assoc_Index;
Assoc_Num : Assoc_Index;
Assoc_Next : Assoc_Index;
end record;
type Assoc is record
Old_Id : Entity_Id := Empty;
New_Id : Entity_Id := Empty;
Kind : Scope_Kind := S_Local;
Next : Assoc_Index := No_Assoc;
end record;
-- All maps are accessed through the following table. The map attribute
-- of a generic unit or an instance is an index into this table.
package Maps_Table is new Table.Table (
Table_Component_Type => Map_Info,
Table_Index_Type => Map,
Table_Low_Bound => 0,
Table_Initial => 100,
Table_Increment => 10,
Table_Name => "Maps_Table");
-- All headers for hash tables are allocated in one global table. Each
-- map stores the offset into this table at which its own headers start.
package Headers_Table is new Table.Table (
Table_Component_Type => Assoc_Index,
Table_Index_Type => Header_Index,
Table_Low_Bound => 0,
Table_Initial => 1000,
Table_Increment => 10,
Table_Name => "Headers_Table");
-- All associations are allocated in one global table. Each map stores
-- the offset into this table at which its own associations start.
package Associations_Table is new Table.Table (
Table_Component_Type => Assoc,
Table_Index_Type => Assoc_Index,
Table_Low_Bound => 1,
Table_Initial => 1000,
Table_Increment => 10,
Table_Name => "Associations_Table");
end Sem_Maps;
gcc/ada/sem_mech.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ M E C H --
-- --
-- S p e c --
-- --
-- $Revision: 1.6 $ --
-- --
-- Copyright (C) 1996-1997 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package contains the routine used to establish calling mechanisms
-- The reason we separate this off into its own package is that it is
-- entirely possible that it may need some target specific specialization.
with Types; use Types;
package Sem_Mech is
-------------------------------------------------
-- Definitions for Parameter Mechanism Control --
-------------------------------------------------
-- For parameters passed to subprograms, and for function return values,
-- as passing mechanism is defined. The entity attribute Mechanism returns
-- an indication of the mechanism, and Set_Mechanism can be used to set
-- the mechanism. At the program level, there are three ways to explicitly
-- set the mechanism:
-- An Import_xxx or Export_xxx pragma (where xxx is Function, Procedure,
-- or Valued_Procedure) can explicitly set the mechanism for either a
-- parameter or a function return value. A mechanism explicitly set by
-- such a pragma overrides the effect of C_Pass_By_Copy described below.
-- If convention C_Pass_By_Copy is set for a record, and the record type
-- is used as the formal type of a subprogram with a foreign convention,
-- then the mechanism is set to By_Copy.
-- If a pragma C_Pass_By_Copy applies, and a record type has Convention
-- C, and the record type is used as the formal type of a subprogram
-- with a foreign convention, then the mechanism is set to use By_Copy
-- if the size of the record is sufficiently small (as determined by
-- the value of the parameter to pragma C_Pass_By_Copy).
-- The subtype Mechanism_Type (declared in Types) is used to describe
-- the mechanism to be used. The following special values of this type
-- specify the mechanism, as follows.
Default_Mechanism : constant Mechanism_Type := 0;
-- The default setting indicates that the backend will choose the proper
-- default mechanism. This depends on the convention of the subprogram
-- involved, and is generally target dependent. In the compiler, the
-- backend chooses the mechanism in this case in accordance with any
-- requirements imposed by the ABI. Note that Default is never used for
-- record types on foreign convention subprograms, since By_Reference
-- is forced for such types unless one of the above described approaches
-- is used to explicitly force By_Copy.
By_Copy : constant Mechanism_Type := -1;
-- Passing by copy is forced. The exact meaning of By_Copy (e.g. whether
-- at a low level the value is passed in registers, or the value is copied
-- and a pointer is passed), is determined by the backend in accordance
-- with requirements imposed by the ABI. Note that in the extended import
-- and export pragma mechanisms, this is called Value, rather than Copy.
By_Reference : constant Mechanism_Type := -2;
-- Passing by reference is forced. This is always equivalent to passing
-- a simple pointer in the case of subprograms with a foreign convention.
-- For unconstrained arrays passed to foreign convention subprograms, the
-- address of the first element of the array is passed. For convention
-- Ada, the result is logically to pass a reference, but the precise
-- mechanism (e.g. to pass bounds of unconstrained types and other needed
-- special information) is determined by the backend in accordance with
-- requirements imposed by the ABI as interpreted for Ada.
By_Descriptor : constant Mechanism_Type := -3;
By_Descriptor_UBS : constant Mechanism_Type := -4;
By_Descriptor_UBSB : constant Mechanism_Type := -5;
By_Descriptor_UBA : constant Mechanism_Type := -6;
By_Descriptor_S : constant Mechanism_Type := -7;
By_Descriptor_SB : constant Mechanism_Type := -8;
By_Descriptor_A : constant Mechanism_Type := -9;
By_Descriptor_NCA : constant Mechanism_Type := -10;
-- These values are used only in OpenVMS ports of GNAT. Pass by descriptor
-- is forced, as described in the OpenVMS ABI. The suffix indicates the
-- descriptor type:
--
-- UBS unaligned bit string
-- UBSB aligned bit string with arbitrary bounds
-- UBA unaligned bit array
-- S string, also a scalar or access type parameter
-- SB string with arbitrary bounds
-- A contiguous array
-- NCA non-contiguous array
--
-- Note: the form with no suffix is used if the Import/Export pragma
-- uses the simple form of the mechanism name where no descriptor
-- type is supplied. In this case the back end assigns a descriptor
-- type based on the Ada type in accordance with the OpenVMS ABI.
subtype Descriptor_Codes is Mechanism_Type
range By_Descriptor_NCA .. By_Descriptor;
-- Subtype including all descriptor mechanisms
-- All the above special values are non-positive. Positive values for
-- Mechanism_Type values have a special meaning. They are used only in
-- the case of records, as a result of the use of the C_Pass_By_Copy
-- pragma, and the meaning is that if the size of the record is known
-- at compile time and does not exceed the mechanism type value, then
-- By_Copy passing is forced, otherwise By_Reference is forced.
----------------------
-- Global Variables --
----------------------
Default_C_Record_Mechanism : Mechanism_Type := By_Reference;
-- This value is the default mechanism used for C convention records
-- in foreign-convention subprograms if no mechanism is otherwise
-- specified. This value is modified appropriately by the occurrence
-- of a C_Pass_By_Copy configuration pragma.
-----------------
-- Subprograms --
-----------------
procedure Set_Mechanisms (E : Entity_Id);
-- E is a subprogram or subprogram type that has been frozen, so the
-- convention of the subprogram and all its formal types and result
-- type in the case of a function are established. The function of
-- this call is to set mechanism values for formals and for the
-- function return if they have not already been explicitly set by
-- a use of an extended Import or Export pragma. The idea is to set
-- mechanism values whereever the semantics is dictated by either
-- requirements or implementation advice in the RM, and to leave
-- the mechanism set to Default if there is no requirement, so that
-- the back-end is free to choose the most efficient method.
procedure Set_Mechanism_Value (Ent : Entity_Id; Mech_Name : Node_Id);
-- Mech is a parameter passing mechanism (see Import_Function syntax
-- for MECHANISM_NAME). This routine checks that the mechanism argument
-- has the right form, and if not issues an error message. If the
-- argument has the right form then the Mechanism field of Ent is
-- set appropriately. It also performs some error checks. Note that
-- the mechanism name has not been analyzed (and cannot indeed be
-- analyzed, since it is semantic nonsense), so we get it in the
-- exact form created by the parser.
procedure Set_Mechanism_With_Checks
(Ent : Entity_Id;
Mech : Mechanism_Type;
Enod : Node_Id);
-- Sets the mechanism of Ent to the given Mech value, after first checking
-- that the request makes sense. If it does not make sense, a warning is
-- posted on node Enod, and the Mechanism of Ent is unchanged.
end Sem_Mech;
gcc/ada/sem_prag.adb 0 → 100644
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/sem_prag.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ P R A G --
-- --
-- S p e c --
-- --
-- $Revision: 1.6 $ --
-- --
-- Copyright (C) 1992-1997 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- Pragma handling is isolated in a separate package
-- (logically this processing belongs in chapter 4)
with Types; use Types;
package Sem_Prag is
procedure Analyze_Pragma (N : Node_Id);
-- Analyze procedure for pragma reference node N
function Is_Pragma_String_Literal (Par : Node_Id) return Boolean;
-- Given an N_Pragma_Argument_Association node, Par, which has the form
-- of an operator symbol, determines whether or not it should be treated
-- as an string literal. This is called by Sem_Ch6.Analyze_Operator_Symbol.
-- If True is returned, the argument is converted to a string literal. If
-- False is returned, then the argument is treated as an entity reference
-- to the operator.
procedure Process_Compilation_Unit_Pragmas (N : Node_Id);
-- Called at the start of processing compilation unit N to deal with
-- any special issues regarding pragmas. In particular, we have to
-- deal with Suppress_All at this stage, since it appears after the
-- unit instead of before.
procedure Set_Encoded_Interface_Name (E : Entity_Id; S : Node_Id);
-- This routine is used to set an encoded interface name. The node
-- S is an N_String_Literal node for the external name to be set, and
-- E is an entity whose Interface_Name field is to be set. In the
-- normal case where S contains a name that is a valid C identifier,
-- then S is simply set as the value of the Interface_Name. Otherwise
-- it is encoded. See the body for details of the encoding. This
-- encoding is only done on VMS systems, since it seems pretty silly,
-- but is needed to pass some dubious tests in the test suite.
end Sem_Prag;
gcc/ada/sem_res.adb 0 → 100644
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/sem_res.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ R E S --
-- --
-- S p e c --
-- --
-- $Revision: 1.19 $
-- --
-- Copyright (C) 1992-1999 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- Resolution processing for all subexpression nodes. Note that the separate
-- package Sem_Aggr contains the actual resolution routines for aggregates,
-- which are separated off since aggregate processing is complex.
with Snames; use Snames;
with Types; use Types;
package Sem_Res is
-- As described in Sem_Ch4, the type resolution proceeds in two phases.
-- The first phase is a bottom up pass that is achieved during the
-- recursive traversal performed by the Analyze procedures. This phase
-- determines unambiguous types, and collects sets of possible types
-- where the interpretation is potentially ambiguous.
-- On completing this bottom up pass, which corresponds to a call to
-- Analyze on a complete context, the Resolve routine is called which
-- performs a top down resolution with recursive calls to itself to
-- resolve operands.
-- Since in practice a lot of semantic analysis has to be postponed until
-- types are known (e.g. static folding, setting of suppress flags), the
-- Resolve routines also complete the semantic analyze, and also call the
-- expander for possibly expansion of the completely type resolved node.
procedure Resolve (N : Node_Id; Typ : Entity_Id);
procedure Resolve (N : Node_Id; Typ : Entity_Id; Suppress : Check_Id);
-- Top level type-checking procedure, called in a complete context. The
-- construct N, which is a subexpression, has already been analyzed, and
-- is required to be of type Typ given the analysis of the context (which
-- uses the information gathered on the bottom up phase in Analyze). The
-- resolve routines do various other processing, e.g. static evaluation.
-- If a Suppress argument is present, then the resolution is done with the
-- specified check suppressed (can be All_Checks to suppress all checks).
procedure Resolve_Discrete_Subtype_Indication
(N : Node_Id;
Typ : Entity_Id);
-- Resolve subtype indications in choices (case statements and
-- aggregates) and in index constraints. Note that the resulting Etype
-- of the subtype indication node is set to the Etype of the contained
-- range (i.e. an Itype is not constructed for the actual subtype).
procedure Resolve_Entry (Entry_Name : Node_Id);
-- Find name of entry being called, and resolve prefix of name with its
-- own type. For now we assume that the prefix cannot be overloaded and
-- the name of the entry plays no role in the resolution.
procedure Analyze_And_Resolve (N : Node_Id);
procedure Analyze_And_Resolve (N : Node_Id; Typ : Entity_Id);
procedure Analyze_And_Resolve
(N : Node_Id;
Typ : Entity_Id;
Suppress : Check_Id);
procedure Analyze_And_Resolve
(N : Node_Id;
Suppress : Check_Id);
-- These routines combine the effect of Analyze and Resolve. If a Suppress
-- argument is present, then the analysis is done with the specified check
-- suppressed (can be All_Checks to suppress all checks). These checks are
-- suppressed for both the analysis and resolution. If the type argument
-- is not present, then the Etype of the expression after the Analyze
-- call is used for the Resolve.
procedure Check_Parameterless_Call (N : Node_Id);
-- Several forms of names can denote calls to entities without para-
-- meters. The context determines whether the name denotes the entity
-- or a call to it. When it is a call, the node must be rebuilt
-- accordingly (deprocedured, in A68 terms) and renalyzed to obtain
-- possible interpretations.
--
-- The name may be that of an overloadable construct, or it can be an
-- explicit dereference of a prefix that denotes an access to subprogram.
-- In that case, we want to convert the name into a call only if the
-- context requires the return type of the subprogram. Finally, a
-- parameterless protected subprogram appears as a selected component.
--
-- The parameter T is the Typ for the corresponding resolve call.
procedure Pre_Analyze_And_Resolve (N : Node_Id; T : Entity_Id);
-- Performs a pre-analysis of expression node N. During pre-analysis
-- N is analyzed and then resolved against type T, but no expansion
-- is carried out for N or its children. For more info on pre-analysis
-- read the spec of Sem.
procedure Pre_Analyze_And_Resolve (N : Node_Id);
-- Same, but use type of node because context does not impose a single
-- type.
end Sem_Res;
gcc/ada/sem_smem.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ S M E M --
-- --
-- B o d y --
-- --
-- $Revision: 1.5 $
-- --
-- Copyright (C) 1998-2000, 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Atree; use Atree;
with Einfo; use Einfo;
with Errout; use Errout;
with Namet; use Namet;
with Sinfo; use Sinfo;
with Snames; use Snames;
package body Sem_Smem is
function Contains_Access_Type (T : Entity_Id) return Boolean;
-- This function determines if type T is an access type, or contains
-- a component (array, record, protected type cases) that contains
-- an access type (recursively defined in the appropriate manner).
----------------------
-- Check_Shared_Var --
----------------------
procedure Check_Shared_Var
(Id : Entity_Id;
T : Entity_Id;
N : Node_Id)
is
begin
-- We cannot tolerate aliased variables, because they might be
-- modified via an aliased pointer, and we could not detect that
-- this was happening (to update the corresponding shared memory
-- file), so we must disallow all use of Aliased
if Aliased_Present (N) then
Error_Msg_N
("aliased variables " &
"not supported in Shared_Passive partitions",
N);
-- We can't support access types at all, since they are local
-- pointers that cannot in any simple way be transmitted to other
-- partitions.
elsif Is_Access_Type (T) then
Error_Msg_N
("access type variables " &
"not supported in Shared_Passive partitions",
Id);
-- We cannot tolerate types that contain access types, same reasons
elsif Contains_Access_Type (T) then
Error_Msg_N
("types containing access components " &
"not supported in Shared_Passive partitions",
Id);
-- Currently we do not support unconstrained record types, since we
-- use 'Write to write out values. This could probably be special
-- cased and handled in the future if necessary.
elsif Is_Record_Type (T)
and then not Is_Constrained (T)
then
Error_Msg_N
("unconstrained variant records " &
"not supported in Shared_Passive partitions",
Id);
end if;
end Check_Shared_Var;
--------------------------
-- Contains_Access_Type --
--------------------------
function Contains_Access_Type (T : Entity_Id) return Boolean is
C : Entity_Id;
begin
if Is_Access_Type (T) then
return True;
elsif Is_Array_Type (T) then
return Contains_Access_Type (Component_Type (T));
elsif Is_Record_Type (T) then
if Has_Discriminants (T) then
C := First_Discriminant (T);
while Present (C) loop
if Comes_From_Source (C) then
return True;
else
C := Next_Discriminant (C);
end if;
end loop;
end if;
C := First_Component (T);
while Present (C) loop
-- For components, ignore internal components other than _Parent
if Comes_From_Source (T)
and then
(Chars (C) = Name_uParent
or else
not Is_Internal_Name (Chars (C)))
and then Contains_Access_Type (Etype (C))
then
return True;
else
C := Next_Component (C);
end if;
end loop;
return False;
elsif Is_Protected_Type (T) then
return Contains_Access_Type (Corresponding_Record_Type (T));
else
return False;
end if;
end Contains_Access_Type;
end Sem_Smem;
gcc/ada/sem_smem.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ S M E M --
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $ --
-- --
-- Copyright (C) 1998-2000, 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package contains routines involved in processing of shared memory
-- variables, i.e. variables declared in shared passive partitions.
with Types; use Types;
package Sem_Smem is
procedure Check_Shared_Var
(Id : Entity_Id;
T : Entity_Id;
N : Node_Id);
-- This routine checks that the object declaration, N, for identifier,
-- Id, of type, T, is valid, i.e. that it does not violate restrictions
-- on the kind of variables we support in shared passive partitions.
end Sem_Smem;
gcc/ada/sem_util.adb 0 → 100644
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/sem_vfpt.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ V F P T --
-- --
-- B o d y --
-- --
-- $Revision: 1.10 $
-- --
-- Copyright (C) 1997-2000, 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with CStand; use CStand;
with Einfo; use Einfo;
with Opt; use Opt;
with Stand; use Stand;
with Targparm; use Targparm;
with Ttypef; use Ttypef;
with Uintp; use Uintp;
pragma Elaborate_All (Uintp);
package body Sem_VFpt is
T_Digits : constant Uint := UI_From_Int (IEEEL_Digits);
-- Digits for IEEE formats
-----------------
-- Set_D_Float --
-----------------
procedure Set_D_Float (E : Entity_Id) is
begin
Init_Size (Base_Type (E), 64);
Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), VAXDF_Digits);
Set_Vax_Float (Base_Type (E), True);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 64);
Init_Alignment (E);
Init_Digits_Value (E, VAXDF_Digits);
Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
end Set_D_Float;
-----------------
-- Set_F_Float --
-----------------
procedure Set_F_Float (E : Entity_Id) is
begin
Init_Size (Base_Type (E), 32);
Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), VAXFF_Digits);
Set_Vax_Float (Base_Type (E), True);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 32);
Init_Alignment (E);
Init_Digits_Value (E, VAXFF_Digits);
Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
end Set_F_Float;
-----------------
-- Set_G_Float --
-----------------
procedure Set_G_Float (E : Entity_Id) is
begin
Init_Size (Base_Type (E), 64);
Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), VAXGF_Digits);
Set_Vax_Float (Base_Type (E), True);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 64);
Init_Alignment (E);
Init_Digits_Value (E, VAXGF_Digits);
Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
end Set_G_Float;
-------------------
-- Set_IEEE_Long --
-------------------
procedure Set_IEEE_Long (E : Entity_Id) is
begin
Init_Size (Base_Type (E), 64);
Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), IEEEL_Digits);
Set_Vax_Float (Base_Type (E), False);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 64);
Init_Alignment (E);
Init_Digits_Value (E, IEEEL_Digits);
Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
end Set_IEEE_Long;
--------------------
-- Set_IEEE_Short --
--------------------
procedure Set_IEEE_Short (E : Entity_Id) is
begin
Init_Size (Base_Type (E), 32);
Init_Alignment (Base_Type (E));
Init_Digits_Value (Base_Type (E), IEEES_Digits);
Set_Vax_Float (Base_Type (E), False);
Set_Float_Bounds (Base_Type (E));
Init_Size (E, 32);
Init_Alignment (E);
Init_Digits_Value (E, IEEES_Digits);
Set_Scalar_Range (E, Scalar_Range (Base_Type (E)));
end Set_IEEE_Short;
------------------------------
-- Set_Standard_Fpt_Formats --
------------------------------
procedure Set_Standard_Fpt_Formats is
begin
-- IEEE case
if Opt.Float_Format = 'I' then
Set_IEEE_Short (Standard_Float);
Set_IEEE_Long (Standard_Long_Float);
Set_IEEE_Long (Standard_Long_Long_Float);
-- Vax float case
else
Set_F_Float (Standard_Float);
if Opt.Float_Format_Long = 'D' then
Set_D_Float (Standard_Long_Float);
else
Set_G_Float (Standard_Long_Float);
end if;
-- Note: Long_Long_Float gets set only in the real VMS case,
-- because this gives better results for testing out the use
-- of VAX float on non-VMS environments with the -gnatdm switch.
if OpenVMS_On_Target then
Set_G_Float (Standard_Long_Long_Float);
end if;
end if;
end Set_Standard_Fpt_Formats;
end Sem_VFpt;
gcc/ada/sem_vfpt.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ V F P T --
-- --
-- S p e c --
-- --
-- $Revision: 1.1 $ --
-- --
-- Copyright (C) 1997 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package contains specialized routines for handling the Alpha
-- floating point formats. It is used only in Alpha implementations.
-- Note that this means that the caller can assume that we are on an
-- Alpha implementation, and that Vax floating-point formats are valid.
with Types; use Types;
package Sem_VFpt is
procedure Set_D_Float (E : Entity_Id);
-- Sets the given floating-point entity to have Vax D_Float format
procedure Set_F_Float (E : Entity_Id);
-- Sets the given floating-point entity to have Vax F_Float format
procedure Set_G_Float (E : Entity_Id);
-- Sets the given floating-point entity to have Vax G_Float format
procedure Set_IEEE_Short (E : Entity_Id);
-- Sets the given floating-point entity to have IEEE Short format
procedure Set_IEEE_Long (E : Entity_Id);
-- Sets the given floating-point entity to have IEEE Long format
procedure Set_Standard_Fpt_Formats;
-- This procedure sets the appropriate formats for the standard
-- floating-point types in Standard, based on the setting of
-- the flags Opt.Float_Format and Opt.Float_Format_Long
end Sem_VFpt;
gcc/ada/sem_warn.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S E M _ W A R N --
-- --
-- S p e c --
-- --
-- $Revision: 1.3 $
-- --
-- Copyright (C) 1999-2000 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package contains the routines used to deal with issuing warnings
-- about uses of uninitialized variables and unused with's. It also has
-- some unrelated routines related to the generation of warnings.
with Types; use Types;
package Sem_Warn is
------------------------------------------
-- Routines to Handle Unused References --
------------------------------------------
procedure Check_References (E : Entity_Id; Anod : Node_Id := Empty);
-- Called at the end of processing a declarative region. The entity E
-- is the entity for the scope. All entities declared in the region,
-- as indicated by First_Entity and the entity chain, are checked to
-- see if they are variables for which warnings need to be posted for
-- either no assignments, or a use before an assignment or no references
-- at all. The Anod node is present for the case of an accept statement,
-- and references the accept statement. This is used to place the warning
-- messages in the right place.
procedure Check_Unset_Reference (N : Node_Id);
-- N is the node for an expression which occurs in a reference position,
-- e.g. as the right side of an assignment. This procedure checks to see
-- if the node is a reference to a variable entity where the entity has
-- Not_Assigned set. If so, the Unset_Reference field is set if it is not
-- the first occurrence. No warning is posted, instead warnings will be
-- posted later by Check_References. The reason we do things that
-- way is that if there are no assignments anywhere, we prefer to flag
-- the entity, rather than a reference to it. Note that for the purposes
-- of this routine, a type conversion or qualified expression whose
-- expression is an entity is also processed. The reason that we do not
-- process these at the point of occurrence is that both these constructs
-- can occur in non-reference positions (e.g. as out parameters).
procedure Check_Unused_Withs (Spec_Unit : Unit_Number_Type := No_Unit);
-- This routine performs two kinds of checks. It checks that all with'ed
-- units are referenced, and that at least one entity of each with'ed
-- unit is referenced (the latter check catches units that are only
-- referenced in a use or package renaming statement). Appropriate
-- warning messages are generated if either of these situations is
-- detected.
--
-- A special case arises when a package body or a subprogram body with
-- a separate spec is being compiled. In this case, a with may appear
-- on the spec, but be needed only by the body. This still generates
-- a warning, but the text is different (the with is not redundant,
-- it is misplaced).
--
-- This special case is implemented by making an initial call to this
-- procedure with Spec_Unit set to the unit number of the separate spec.
-- This call does not generate any warning messages, but instead may
-- result in flags being set in the N_With_Clause node that record that
-- there was no use in the spec.
--
-- The main call (made after all units have been analyzed, with Spec_Unit
-- set to the default value of No_Unit) generates the required warnings
-- using the flags set by the initial call where appropriate to specialize
-- the text of the warning messages.
----------------------------------------
-- Routines to Deal with Conditionals --
----------------------------------------
-- These routines provide the necessary interfacing information to
-- correctly handle references in conditional structures (if/then/end-if,
-- or case/when/end-case). The issue here is that if a variable is only
-- set in some but not all branches of a conditional, then it is not
-- considered as being set by the conditional as a whole.
procedure Start_Unit;
-- Mark start of new unit to be analyzed, deals with fact that a call to
-- Rtsfind may cause new unit to be analyzed in middle of conditional.
procedure End_Unit;
-- Mark end of unit corresponding to previous call to Start_Unit
procedure Start_Conditional (If_Stmt : Boolean);
-- Mark start of a new conditional structure (an if-elsif-else-endif
-- or a case-when-end-case structure). If_Stmt is True for the IF
-- statement case, and False for the CASE statement case.
procedure Start_Branch (Loc : Source_Ptr);
-- Start processing of one branch of conditional previously marked by
-- a call to Start_Conditional (i.e. start of then/elsif/else statements
-- or set of statements after a when condition). The Loc value is the
-- source pointer to be used in warning messages concerning variables
-- not properly initialized in this branch. A branch is terminated by
-- either another Start_Branch or End_Conditional call.
procedure End_Conditional;
-- Terminate conditional started by previous Start_Conditional statement.
---------------------
-- Output Routines --
---------------------
procedure Output_Unreferenced_Messages;
-- Warnings about unreferenced entities are collected till the end of
-- the compilation process (see Check_Unset_Reference for further
-- details). This procedure outputs waiting warnings, if any.
----------------------------
-- Other Warning Routines --
----------------------------
procedure Warn_On_Known_Condition (C : Node_Id);
-- C is a node for a boolean expression resluting from a relational
-- or membership operation. If the expression has a compile time known
-- value, then a warning is output if all the following conditions hold:
--
-- 1. Original expression comes from source. We don't want to generate
-- warnings for internally generated conditionals.
--
-- 2. As noted above, the expression is a relational or membership
-- test, we don't want to generate warnings for boolean variables
-- since this is typical of conditional compilation in Ada.
--
-- 3. The expression appears in a statement, rather than a declaration.
-- In practice, most occurrences in declarations are legitimate
-- conditionalizations, but occurrences in statements are often
-- errors for which the warning is useful.
--
-- 4. The expression does not occur within an instantiation. A non-
-- static expression in a generic may become constant because of
-- the attributes of the actuals, and we do not want to warn on
-- these legitimate constant foldings.
--
-- If all these conditions are met, the warning is issued noting that
-- the result of the test is always false or always true as appropriate.
end Sem_Warn;
gcc/ada/sequenio.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT RUNTIME COMPONENTS --
-- --
-- S E Q U E N T I A L _ I O --
-- --
-- S p e c --
-- --
-- $Revision: 1.8 $ --
-- --
-- This specification is adapted from the Ada Reference Manual for use with --
-- GNAT. In accordance with the copyright of that document, you can freely --
-- copy and modify this specification, provided that if you redistribute a --
-- modified version, any changes that you have made are clearly indicated. --
-- --
------------------------------------------------------------------------------
pragma Ada_95;
with Ada.Sequential_IO;
generic package Sequential_IO renames Ada.Sequential_IO;
gcc/ada/sfn_scan.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S F N _ S C A N --
-- --
-- S p e c --
-- --
-- $Revision: 1.2 $
-- --
-- Copyright (C) 2000-2001 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package provides a stand alone capability for scanning a gnat.adc
-- file for Source_File_Name pragmas. This is for use in tools other than
-- the compiler, which want to scan source file name pragmas without the
-- overhead of the full compiler scanner and parser.
-- Note that neither the package spec, nor the package body, of this
-- unit contains any with statements at all. This is a compeltely
-- independent package, suitable for incorporation into tools that do
-- not access any other units in the GNAT compiler or tools sources.
-- This package is NOT task safe, so multiple tasks that may call the
-- Scan_SFN_Pragmas procedure at the same time are responsibible for
-- avoiding such multiple calls by appropriate synchronization.
package SFN_Scan is
-- The call to SFN_Scan passes pointers to two procedures that are
-- used to store the results of scanning any Source_File_Name pragmas
-- that are encountered. The following access types define the form
-- of these procedures:
type Set_File_Name_Ptr is access
procedure (Typ : Character; U : String; F : String);
-- The procedure with this profile is called when a Source_File_Name
-- pragma of the form having a unit name parameter. Typ is 'b' for
-- a body file name, and 's' for a spec file name. U is a string that
-- contains the unit name, exactly as it appeared in the source file,
-- and F is the file taken from the second parameter.
type Set_File_Name_Pattern_Ptr is access
procedure (Pat : String; Typ : Character; Dot : String; Cas : Character);
-- This is called to process a Source_File_Name pragma whose first
-- argument is a file pattern. Pat is this pattern string, which
-- contains an asterisk to correspond to the unit. Typ is one of
-- ('b'/'s'/'u') for body/spec/subunit, Dot is the separator string
-- for child/subunit names (default is "."), and Cas is one of
-- ('l'/'u'/'m') indicating the required case for the file name.
-- The default setting for Cas is 'l' if no parameter is present.
Cursor : Natural;
-- Used to record the cursor value if a syntax error is found
Syntax_Error_In_GNAT_ADC : exception;
-- Exception raised if a syntax error is found
procedure Scan_SFN_Pragmas
(Source : String;
SFN_Ptr : Set_File_Name_Ptr;
SFNP_Ptr : Set_File_Name_Pattern_Ptr);
-- This is the procedure called to scan a gnat.adc file. The Source
-- parameter points to the full text of the file, with normal line end
-- characters, in the format normally read by the compiler. The two
-- parameters SFN_Ptr and SFNP_Ptr point to procedures that will be
-- called to register Source_File_Name pragmas as they are found.
--
-- If a syntax error is found, then Syntax_Error_In_GNAT_ADC is raised,
-- and the location SFN_Scan.Cursor contains the approximate index of
-- the error in the source string.
--
-- The scan assumes that it is dealing with a valid gnat.adc file,
-- that includes only pragmas and comments. It does not do a full
-- syntax correctness scan by any means, but if it does find anything
-- that it can tell is wrong it will immediately raise the exception
-- to indicate the aproximate location of the error
end SFN_Scan;
gcc/ada/sinfo-cn.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S I N F O . C N --
-- --
-- B o d y --
-- --
-- $Revision: 1.7 $
-- --
-- Copyright (C) 1992-2001 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This child package of Sinfo contains some routines that permit in place
-- alteration of existing tree nodes by changing the value in the Nkind
-- field. Since Nkind functions logically in a manner similart to a variant
-- record discriminant part, such alterations cannot be permitted in a
-- general manner, but in some specific cases, the fields of related nodes
-- have been deliberately layed out in a manner that permits such alteration.
-- that determin
with Atree; use Atree;
package body Sinfo.CN is
use Atree.Unchecked_Access;
-- This package is one of the few packages which is allowed to make direct
-- references to tree nodes (since it is in the business of providing a
-- higher level of tree access which other clients are expected to use and
-- which implements checks).
------------------------------------------------------------
-- Change_Character_Literal_To_Defining_Character_Literal --
------------------------------------------------------------
procedure Change_Character_Literal_To_Defining_Character_Literal
(N : in out Node_Id)
is
begin
Set_Nkind (N, N_Defining_Character_Literal);
N := Extend_Node (N);
end Change_Character_Literal_To_Defining_Character_Literal;
------------------------------------
-- Change_Conversion_To_Unchecked --
------------------------------------
procedure Change_Conversion_To_Unchecked (N : Node_Id) is
begin
Set_Do_Overflow_Check (N, False);
Set_Do_Tag_Check (N, False);
Set_Do_Length_Check (N, False);
Set_Nkind (N, N_Unchecked_Type_Conversion);
end Change_Conversion_To_Unchecked;
----------------------------------------------
-- Change_Identifier_To_Defining_Identifier --
----------------------------------------------
procedure Change_Identifier_To_Defining_Identifier (N : in out Node_Id) is
begin
Set_Nkind (N, N_Defining_Identifier);
N := Extend_Node (N);
end Change_Identifier_To_Defining_Identifier;
--------------------------------------------------------
-- Change_Operator_Symbol_To_Defining_Operator_Symbol --
--------------------------------------------------------
procedure Change_Operator_Symbol_To_Defining_Operator_Symbol
(N : in out Node_Id)
is
begin
Set_Nkind (N, N_Defining_Operator_Symbol);
Set_Node2 (N, Empty); -- Clear unused Str2 field
N := Extend_Node (N);
end Change_Operator_Symbol_To_Defining_Operator_Symbol;
----------------------------------------------
-- Change_Operator_Symbol_To_String_Literal --
----------------------------------------------
procedure Change_Operator_Symbol_To_String_Literal (N : Node_Id) is
begin
Set_Nkind (N, N_String_Literal);
Set_Node1 (N, Empty); -- clear Name1 field
end Change_Operator_Symbol_To_String_Literal;
------------------------------------------------
-- Change_Selected_Component_To_Expanded_Name --
------------------------------------------------
procedure Change_Selected_Component_To_Expanded_Name (N : Node_Id) is
begin
Set_Nkind (N, N_Expanded_Name);
Set_Chars (N, Chars (Selector_Name (N)));
end Change_Selected_Component_To_Expanded_Name;
end Sinfo.CN;
gcc/ada/sinfo-cn.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S I N F O . C N --
-- --
-- S p e c --
-- --
-- $Revision: 1.9 $
-- --
-- Copyright (C) 1992-2001, 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This child package of Sinfo contains some routines that permit in place
-- alteration of existing tree nodes by changing the value in the Nkind
-- field. Since Nkind functions logically in a manner similar to a variant
-- record discriminant part, such alterations cannot be permitted in a
-- general manner, but in some specific cases, the fields of related nodes
-- have been deliberately laid out in a manner that permits such alteration.
package Sinfo.CN is
procedure Change_Identifier_To_Defining_Identifier (N : in out Node_Id);
-- N must refer to a node of type N_Identifier. This node is modified to
-- be of type N_Defining_Identifier. The scanner always returns identifiers
-- as N_Identifier. The parser then uses this routine to change the node
-- to be a defining identifier where the context demands it. This routine
-- also allocates the necessary extension node. Note that this procedure
-- may (but is not required to) change the Id of the node in question.
procedure Change_Character_Literal_To_Defining_Character_Literal
(N : in out Node_Id);
-- Similar processing for a character literal
procedure Change_Operator_Symbol_To_Defining_Operator_Symbol
(N : in out Node_Id);
-- Similar processing for an operator symbol
procedure Change_Conversion_To_Unchecked (N : Node_Id);
-- Change checked conversion node to unchecked conversion node, clearing
-- irrelevant check flags (other fields in the two nodes are identical)
procedure Change_Operator_Symbol_To_String_Literal (N : Node_Id);
-- The scanner returns any string that looks like an operator symbol as
-- a N_Operator_Symbol node. The parser then uses this procedure to change
-- the node to a normal N_String_Literal node if the context is not one
-- in which an operator symbol is required. There are some cases where the
-- parser cannot tell, in which case this transformation happens later on.
procedure Change_Selected_Component_To_Expanded_Name (N : Node_Id);
-- The parser always generates Selected_Component nodes. The semantics
-- modifies these to Expanded_Name nodes where appropriate. Note that
-- on return the Chars field is set to a copy of the contents of the
-- Chars field of the Selector_Name field.
end Sinfo.CN;
gcc/ada/sinfo.adb 0 → 100644
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/sinfo.ads 0 → 100644
This source diff could not be displayed because it is too large. You can view the blob instead.
gcc/ada/sinput-l.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S I N P U T . L --
-- --
-- S p e c --
-- --
-- $Revision: 1.14 $ --
-- --
-- Copyright (C) 1992-2001, 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This child package contains the routines used to actually load a source
-- file and create entries in the source file table. It also contains the
-- routines to create virtual entries for instantiations. This is separated
-- off into a child package to avoid a dependence of Sinput on Osint which
-- would cause trouble in the tree read/write routines.
with Types; use Types;
package Sinput.L is
-------------------------------------------
-- Subprograms for Loading Source Files --
-------------------------------------------
function Load_Source_File (N : File_Name_Type) return Source_File_Index;
-- Given a source file name, returns the index of the corresponding entry
-- in the source file table. If the file is not currently loaded, then
-- this is the call that causes the source file to be read and an entry
-- made in the table. A new entry in the table has the file name and time
-- stamp entries set and the Casing entries set to Unknown. Version is set
-- to all blanks, and the lines table is initialized but only the first
-- entry is set (and Last_Line is set to 1). If the given source file
-- cannot be opened, then the value returned is No_Source_File.
function Load_Config_File (N : File_Name_Type) return Source_File_Index;
-- Similar to Load_Source_File, except that the file name is always
-- interpreted in the context of the current working directory.
procedure Complete_Source_File_Entry;
-- Called on completing the parsing of a source file. This call completes
-- the source file table entry for the current source file.
function Source_File_Is_Subunit (X : Source_File_Index) return Boolean;
-- This function determines if a source file represents a subunit. It
-- works by scanning for the first compilation unit token, and returning
-- True if it is the token SEPARATE. It will return False otherwise,
-- meaning that the file cannot possibly be a legal subunit. This
-- function does NOT do a complete parse of the file, or build a
-- tree. It is used in the main driver in the check for bad bodies.
-------------------------------------------------
-- Subprograms for Dealing With Instantiations --
-------------------------------------------------
type Sloc_Adjustment is private;
-- Type returned by Create_Instantiation_Source for use in subsequent
-- calls to Adjust_Instantiation_Sloc.
procedure Create_Instantiation_Source
(Inst_Node : Entity_Id;
Template_Id : Entity_Id;
A : out Sloc_Adjustment);
-- This procedure creates the source table entry for an instantiation.
-- Inst_Node is the instantiation node, and Template_Id is the defining
-- identifier of the generic declaration or body unit as appropriate.
-- A is set to an adjustment factor to be used in subsequent calls to
-- Adjust_Instantiation_Sloc.
procedure Adjust_Instantiation_Sloc (N : Node_Id; A : Sloc_Adjustment);
-- The instantiation tree is created by copying the tree of the generic
-- template (including the original Sloc values), and then applying
-- Adjust_Instantiation_Sloc to each copied node to adjust the Sloc
-- to reference the source entry for the instantiation.
------------------------------------------------
-- Subprograms for Writing Debug Source Files --
------------------------------------------------
procedure Create_Debug_Source
(Source : Source_File_Index;
Loc : out Source_Ptr);
-- Given a source file, creates a new source file table entry to be used
-- for the debug source file output (Debug_Generated_Code switch set).
-- Loc is set to the initial Sloc value for the first line. This call
-- also creates the debug source output file (using Create_Debug_File).
procedure Write_Debug_Line (Str : String; Loc : in out Source_Ptr);
-- This procedure is called to write a line to the debug source file
-- previously created by Create_Debug_Source using Write_Debug_Info.
-- Str is the source line to be written to the file (it does not include
-- an end of line character). On entry Loc is the Sloc value previously
-- returned by Create_Debug_Source or Write_Debug_Line, and on exit,
-- Sloc is updated to point to the start of the next line to be written,
-- taking into account the length of the ternminator that was written by
-- Write_Debug_Info.
procedure Close_Debug_Source;
-- This procedure completes the source table entry for the debug file
-- previously created by Create_Debug_Source, and written using the
-- Write_Debug_Line procedure. It then calls Close_Debug_File to
-- complete the writing of the file itself.
private
type Sloc_Adjustment is record
Adjust : Source_Ptr;
-- Adjustment factor. To be added to source location values in the
-- source table entry for the template to get corresponding sloc
-- values for the instantiation image of the template. This is not
-- really a Source_Ptr value, but rather an offset, but it is more
-- convenient to represent it as a Source_Ptr value and this is a
-- private type anyway.
Lo, Hi : Source_Ptr;
-- Lo and hi values to which adjustment factor can legitimately
-- be applied, used to ensure that no incorrect adjustments are
-- made. Really it is a bug if anyone ever tries to adjust outside
-- this range, but since we are only doing this anyway for getting
-- better error messages, it is not critical
end record;
end Sinput.L;
gcc/ada/sinput-p.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S I N P U T . P --
-- --
-- B o d y --
-- --
-- $Revision: 1.9 $
-- --
-- Copyright (C) 1992-2001 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Ada.Unchecked_Conversion;
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Namet; use Namet;
with Opt; use Opt;
with System; use System;
package body Sinput.P is
First : Boolean := True;
-- Flag used when Load_Project_File is called the first time,
-- to set Main_Source_File.
-- The flag is reset to False at the first call to Load_Project_File
-----------------------
-- Load_Project_File --
-----------------------
function Load_Project_File (Path : String) return Source_File_Index is
Src : Source_Buffer_Ptr;
X : Source_File_Index;
Lo : Source_Ptr;
Hi : Source_Ptr;
Source_File_FD : File_Descriptor;
-- The file descriptor for the current source file. A negative value
-- indicates failure to open the specified source file.
Len : Integer;
-- Length of file. Assume no more than 2 gigabytes of source!
Actual_Len : Integer;
Path_Id : Name_Id;
File_Id : Name_Id;
begin
if Path = "" then
return No_Source_File;
end if;
Source_File.Increment_Last;
X := Source_File.Last;
if First then
Main_Source_File := X;
First := False;
end if;
if X = Source_File.First then
Lo := First_Source_Ptr;
else
Lo := Source_File.Table (X - 1).Source_Last + 1;
end if;
Name_Len := Path'Length;
Name_Buffer (1 .. Name_Len) := Path;
Path_Id := Name_Find;
Name_Buffer (Name_Len + 1) := ASCII.NUL;
-- Open the source FD, note that we open in binary mode, because as
-- documented in the spec, the caller is expected to handle either
-- DOS or Unix mode files, and there is no point in wasting time on
-- text translation when it is not required.
Source_File_FD := Open_Read (Name_Buffer'Address, Binary);
if Source_File_FD = Invalid_FD then
Source_File.Decrement_Last;
return No_Source_File;
end if;
Len := Integer (File_Length (Source_File_FD));
-- Set Hi so that length is one more than the physical length,
-- allowing for the extra EOF character at the end of the buffer
Hi := Lo + Source_Ptr (Len);
-- Do the actual read operation
declare
subtype Actual_Source_Buffer is Source_Buffer (Lo .. Hi);
-- Physical buffer allocated
type Actual_Source_Ptr is access Actual_Source_Buffer;
-- This is the pointer type for the physical buffer allocated
Actual_Ptr : Actual_Source_Ptr := new Actual_Source_Buffer;
-- And this is the actual physical buffer
begin
-- Allocate source buffer, allowing extra character at end for EOF
-- Some systems (e.g. VMS) have file types that require one
-- read per line, so read until we get the Len bytes or until
-- there are no more characters.
Hi := Lo;
loop
Actual_Len := Read (Source_File_FD, Actual_Ptr (Hi)'Address, Len);
Hi := Hi + Source_Ptr (Actual_Len);
exit when Actual_Len = Len or Actual_Len <= 0;
end loop;
Actual_Ptr (Hi) := EOF;
-- Now we need to work out the proper virtual origin pointer to
-- return. This is exactly Actual_Ptr (0)'Address, but we have
-- to be careful to suppress checks to compute this address.
declare
pragma Suppress (All_Checks);
function To_Source_Buffer_Ptr is new
Ada.Unchecked_Conversion (Address, Source_Buffer_Ptr);
begin
Src := To_Source_Buffer_Ptr (Actual_Ptr (0)'Address);
end;
end;
-- Read is complete, get time stamp and close file and we are done
Close (Source_File_FD);
-- Get the file name, without path information
declare
Index : Positive := Path'Last;
begin
while Index > Path'First loop
exit when Path (Index - 1) = '/';
exit when Path (Index - 1) = Directory_Separator;
Index := Index - 1;
end loop;
Name_Len := Path'Last - Index + 1;
Name_Buffer (1 .. Name_Len) := Path (Index .. Path'Last);
File_Id := Name_Find;
end;
declare
S : Source_File_Record renames Source_File.Table (X);
begin
S := (Debug_Source_Name => Path_Id,
File_Name => File_Id,
First_Mapped_Line => No_Line_Number,
Full_File_Name => Path_Id,
Full_Ref_Name => Path_Id,
Identifier_Casing => Unknown,
Instantiation => No_Location,
Keyword_Casing => Unknown,
Last_Source_Line => 1,
License => Unknown,
Lines_Table => null,
Lines_Table_Max => 1,
Logical_Lines_Table => null,
Num_SRef_Pragmas => 0,
Reference_Name => File_Id,
Sloc_Adjust => 0,
Source_Checksum => 0,
Source_First => Lo,
Source_Last => Hi,
Source_Text => Src,
Template => No_Source_File,
Time_Stamp => Empty_Time_Stamp);
Alloc_Line_Tables (S, Opt.Table_Factor * Alloc.Lines_Initial);
S.Lines_Table (1) := Lo;
end;
return X;
end Load_Project_File;
--------------------------------
-- Restore_Project_Scan_State --
--------------------------------
procedure Restore_Project_Scan_State
(Saved_State : in Saved_Project_Scan_State)
is
begin
Restore_Scan_State (Saved_State.Scan_State);
Source := Saved_State.Source;
Current_Source_File := Saved_State.Current_Source_File;
end Restore_Project_Scan_State;
-----------------------------
-- Save_Project_Scan_State --
-----------------------------
procedure Save_Project_Scan_State
(Saved_State : out Saved_Project_Scan_State)
is
begin
Save_Scan_State (Saved_State.Scan_State);
Saved_State.Source := Source;
Saved_State.Current_Source_File := Current_Source_File;
end Save_Project_Scan_State;
end Sinput.P;
gcc/ada/sinput-p.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S I N P U T . P --
-- --
-- S p e c --
-- --
-- $Revision: 1.3 $
-- --
-- Copyright (C) 1992-2001, 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This child package contains the routines used to actually load a project
-- file and create entries in the source file table. It also contains two
-- routines to save and restore a project scan context.
with Scans; use Scans;
with Types; use Types;
package Sinput.P is
function Load_Project_File (Path : String) return Source_File_Index;
-- Load into memory the source of a project source file.
-- Initialize the Scans state.
type Saved_Project_Scan_State is limited private;
-- Used to save project scan state in following two routines
procedure Save_Project_Scan_State
(Saved_State : out Saved_Project_Scan_State);
pragma Inline (Save_Project_Scan_State);
-- Save the Scans state, as well as the values of
-- Source and Current_Source_File.
procedure Restore_Project_Scan_State
(Saved_State : Saved_Project_Scan_State);
pragma Inline (Restore_Project_Scan_State);
-- Restore the Scans state and the values of
-- Source and Current_Source_File.
private
type Saved_Project_Scan_State is record
Scan_State : Saved_Scan_State;
Source : Source_Buffer_Ptr;
Current_Source_File : Source_File_Index;
end record;
end Sinput.P;
gcc/ada/sprint.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S P R I N T --
-- --
-- S p e c --
-- --
-- $Revision: 1.44 $
-- --
-- Copyright (C) 1992-1999, 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package (source print) contains routines for printing the source
-- program corresponding to a specified syntax tree. These routines are
-- intended for debugging use in the compiler (not as a user level pretty
-- print tool). Only information present in the tree is output (e.g. no
-- comments are present in the output), and as far as possible we avoid
-- making any assumptions about the correctness of the tree, so a bad
-- tree may either blow up on a debugging check, or list incorrect source.
with Types; use Types;
package Sprint is
-----------------------
-- Syntax Extensions --
-----------------------
-- When the generated tree is printed, it contains constructs that are not
-- pure Ada. For convenience, syntactic extensions to Ada have been defined
-- purely for the purposes of this printout (they are not recognized by the
-- parser)
-- Allocator new xxx [storage_pool = xxx]
-- Cleanup action at end procedure name;
-- Conditional expression (if expr then expr else expr)
-- Conversion wi Float_Truncate target^(source)
-- Convert wi Conversion_OK target?(source)
-- Convert wi Rounded_Result target@(source)
-- Divide wi Treat_Fixed_As_Integer x #/ y
-- Divide wi Rounded_Result x @/ y
-- Expression with range check {expression}
-- Operator with range check {operator} (e.g. {+})
-- Free statement free expr [storage_pool = xxx]
-- Freeze entity with freeze actions freeze entityname [ actions ]
-- Interpretation interpretation type [, entity]
-- Intrinsic calls function-name!(arg, arg, arg)
-- Itype reference reference itype
-- Label declaration labelname : label
-- Mod wi Treat_Fixed_As_Integer x #mod y
-- Multiple concatenation expr && expr && expr ... && expr
-- Multiply wi Treat_Fixed_As_Integer x #* y
-- Multiply wi Rounded_Result x @* y
-- Others choice for cleanup when all others
-- Raise xxx error [xxx_error [when condition]]
-- Rational literal See UR_Write for details
-- Rem wi Treat_Fixed_As_Integer x #rem y
-- Reference expression'reference
-- Shift nodes shift_name!(expr, count)
-- Subprogram_Info subprog'Subprogram_Info
-- Unchecked conversion target_type!(source_expression)
-- Unchecked expression `(expression)
-- Validate_Unchecked_Conversion validate unchecked_conversion
-- (src-type, target-typ);
-- Note: the storage_pool parameters for allocators and the free node
-- are omitted if the Storage_Pool field is Empty, indicating use of
-- the standard default pool.
-----------------
-- Subprograms --
-----------------
procedure Source_Dump;
-- This routine is called from the GNAT main program to dump source as
-- requested by debug options. The relevant debug options are:
-- -ds print source from tree, both original and generated code
-- -dg print source from tree, including only the generated code
-- -do print source from tree, including only the original code
-- -df modify the above to include all units, not just the main unit
-- -sz print source from tree for package Standard
procedure Sprint_Comma_List (List : List_Id);
-- Prints the nodes in a list, with separating commas. If the list
-- is empty then no output is generated.
procedure Sprint_Paren_Comma_List (List : List_Id);
-- Prints the nodes in a list, surrounded by parentheses, and separated
-- by comas. If the list is empty, then no output is generated. A blank
-- is output before the initial left parenthesis.
procedure Sprint_Opt_Paren_Comma_List (List : List_Id);
-- Same as normal Sprint_Paren_Comma_List procedure, except that
-- an extra blank is output if List is non-empty, and nothing at all is
-- printed it the argument is No_List.
procedure Sprint_Node_List (List : List_Id);
-- Prints the nodes in a list with no separating characters. This is used
-- in the case of lists of items which are printed on separate lines using
-- the current indentation amount. Note that Sprint_Node_List itself
-- does not generate any New_Line calls.
procedure Sprint_Opt_Node_List (List : List_Id);
-- Like Sprint_Node_List, but prints nothing if List = No_List.
procedure Sprint_Indented_List (List : List_Id);
-- Like Sprint_Line_List, except that the indentation level is
-- increased before outputting the list of items, and then decremented
-- (back to its original level) before returning to the caller.
procedure Sprint_Node (Node : Node_Id);
-- Prints a single node. No new lines are output, except as required for
-- splitting lines that are too long to fit on a single physical line.
-- No output is generated at all if Node is Empty. No trailing or leading
-- blank characters are generated.
procedure Sprint_Opt_Node (Node : Node_Id);
-- Same as normal Sprint_Node procedure, except that one leading
-- blank is output before the node if it is non-empty.
procedure PG (Node : Node_Id);
-- Print generated source for node N (like -gnatdg output). This is
-- intended only for use from gdb for debugging purposes.
procedure PO (Node : Node_Id);
-- Print original source for node N (like -gnatdo output). This is
-- intended only for use from gdb for debugging purposes.
procedure PS (Node : Node_Id);
-- Print generated and original source for node N (like -gnatds output).
-- This is intended only for use from gdb for debugging purposes.
end Sprint;
gcc/ada/stand.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S T A N D --
-- --
-- B o d y --
-- --
-- $Revision: 1.6 $ --
-- --
-- Copyright (C) 1992,1993,1994,1995 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
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 (Standard_Void_Type));
Tree_Read_Int (Int (Standard_Exception_Type));
Tree_Read_Int (Int (Standard_A_String));
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_Numeric));
Tree_Read_Int (Int (Any_Real));
Tree_Read_Int (Int (Any_Scalar));
Tree_Read_Int (Int (Any_String));
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 (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 (Standard_Void_Type));
Tree_Write_Int (Int (Standard_Exception_Type));
Tree_Write_Int (Int (Standard_A_String));
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_Numeric));
Tree_Write_Int (Int (Any_Real));
Tree_Write_Int (Int (Any_Scalar));
Tree_Write_Int (Int (Any_String));
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 (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;
gcc/ada/stringt.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S T R I N G T --
-- --
-- S p e c --
-- --
-- $Revision: 1.39 $
-- --
-- Copyright (C) 1992-2001 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with System; use System;
with Types; use Types;
package Stringt is
-- This package contains routines for handling the strings table which is
-- used to store string constants encountered in the source, and also those
-- additional string constants generated by compile time concatenation and
-- other similar processing.
-- A string constant in this table consists of a series of Char_Code values,
-- so that 16-bit character codes can be properly handled if this feature
-- is implemented in the scanner.
-- There is no guarantee that hashing is used in the implementation, although
-- it maybe. This means that the caller cannot count on having the same Id
-- value for two identical strings stored separately and also cannot count on
-- the two Id values being different.
--------------------------------------
-- String Table Access Subprograms --
--------------------------------------
procedure Initialize;
-- Initializes the strings table for a new compilation. Note that
-- Initialize must not be called if Tree_Read is used.
procedure Lock;
-- Lock internal tables before calling back end
procedure Unlock;
-- Unlock internal tables, in case back end needs to modify them
procedure Start_String;
-- Sets up for storing a new string in the table. To store a string, a
-- call is first made to Start_String, then successive calls are
-- made to Store_String_Character to store the characters of the string.
-- Finally, a call to End_String terminates the entry and returns it Id.
procedure Start_String (S : String_Id);
-- Like Start_String with no parameter, except that the contents of the
-- new string is initialized to be a copy of the given string. A test is
-- made to see if S is the last created string, and if so it is shared,
-- rather than copied, this can be particularly helpful for the case of
-- a continued concatenaion of string constants.
procedure Store_String_Char (C : Char_Code);
procedure Store_String_Char (C : Character);
-- Store next character of string, see description above for Start_String
procedure Store_String_Chars (S : String);
procedure Store_String_Chars (S : String_Id);
-- Store character codes of given string in sequence
procedure Store_String_Int (N : Int);
-- Stored decimal representation of integer with possible leading minus
procedure Unstore_String_Char;
-- Undoes effect of previous Store_String_Char call, used in some error
-- situations of unterminated string constants.
function End_String return String_Id;
-- Terminates current string and returns its Id
function String_Length (Id : String_Id) return Nat;
-- Returns length of previously stored string
function Get_String_Char (Id : String_Id; Index : Int) return Char_Code;
-- Obtains the specified character from a stored string. The lower bound
-- of stored strings is always 1, so the range is 1 .. String_Length (Id).
function String_Equal (L, R : String_Id) return Boolean;
-- Determines if two string literals represent the same string
procedure String_To_Name_Buffer (S : String_Id);
-- Place characters of given string in Name_Buffer, setting Name_Len
procedure Add_String_To_Name_Buffer (S : String_Id);
-- Append characters of given string to Name_Buffer, updating Name_Len
function String_Chars_Address return System.Address;
-- Return address of String_Chars table (used by Back_End call to Gigi)
function String_From_Name_Buffer return String_Id;
-- Given a name stored in Namet.Name_Buffer (length in Namet.Name_Len),
-- returns a string of the corresponding value. The value in Name_Buffer
-- is unchanged, and the cases of letters are unchanged.
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 Tree_Read.
-- 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 Tree_Write
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
-- 16#20# .. 16#7E#, then the single graphic character corresponding to
-- the code is output. For any other codes in the range 16#00# .. 16#FF#,
-- the code is output as ["hh"] where hh is the two digit hex value for
-- the code. Codes greater than 16#FF# are output as ["hhhh"] where hhhh
-- is the four digit hex representation of the code value (high order
-- byte first). Hex letters are always in upper case.
procedure Write_String_Table_Entry (Id : String_Id);
-- Writes a string value with enclosing quotes to the current file using
-- routines in package Output. Does not write an end of line character.
-- This procedure is used for debug output purposes, and also for output
-- of strings specified by pragma Linker Option to the ali file. 7-bit
-- ASCII graphics (except for double quote and left brace) are output
-- literally. The double quote appears as two successive double quotes.
-- All other codes, are output as described for Write_Char_Code. For
-- example, the string created by folding "A" & ASCII.LF & "Hello" will
-- print as "A{0A}Hello". A No_String value prints simply as "no string"
-- without surrounding quote marks.
private
pragma Inline (End_String);
pragma Inline (String_Length);
end Stringt;
gcc/ada/stringt.h 0 → 100644
/****************************************************************************
* *
* GNAT COMPILER COMPONENTS *
* *
* S T R I N G T *
* *
* C Header File *
* *
* $Revision: 1.1 $
* *
* Copyright (C) 1992-2001 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 2, 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 COPYING. If not, write *
* to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, *
* MA 02111-1307, USA. *
* *
* GNAT was originally developed by the GNAT team at New York University. *
* It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). *
* *
****************************************************************************/
/* This file is the C file that corresponds to the Ada package spec
Stringt. It was created manually from stringt.ads and stringt.adb
Note: only the access functions are provided, since the tree transformer
is not allowed to modify the tree or its auxiliary structures.
This package contains routines for handling the strings table which is
used to store string constants encountered in the source, and also those
additional string constants generated by compile time concatenation and
other similar processing.
A string constant in this table consists of a series of Char_Code values,
so that 16-bit character codes can be properly handled if this feature is
implemented in the scanner.
There is no guarantee that hashing is used in the implementation. This
means that the caller cannot count on having the same Id value for two
identical strings stored separately.
The String_Id values reference entries in the Strings table, which
contains String_Entry records that record the length of each stored string
and its starting location in the String_Chars table. */
struct String_Entry
{
Int String_Index;
Int Length;
};
/* Pointer to string entry vector. This pointer is passed to the tree
transformer and stored in a global location for access from here after
subtracting String_First_Entry, so that String_Id values can be used as
subscripts into the vector. */
extern struct String_Entry *Strings_Ptr;
/* Pointer to name characters table. This pointer is passed to the tree
transformer and stored in a global location for access from here. The
String_Index values are subscripts into this array. */
extern Char_Code *String_Chars_Ptr;
/* String_Length returns the length of the specified string. */
INLINE Int String_Length PARAMS ((String_Id));
INLINE Int
String_Length (Id)
String_Id Id;
{
return Strings_Ptr [Id].Length;
}
/* Get_String_Char obtains the specified character from a stored string. The
lower bound of stored strings is always 1, so the range of values is 1 to
String_Length (Id). */
INLINE Char_Code Get_String_Char PARAMS ((String_Id, Int));
INLINE Char_Code
Get_String_Char (Id, Index)
String_Id Id;
Int Index;
{
return String_Chars_Ptr [Strings_Ptr [Id].String_Index + Index - 1];
}
gcc/ada/style.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S T Y L E --
-- --
-- S p e c --
-- --
-- $Revision: 1.12 $
-- --
-- Copyright (C) 1992-2000 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package collects all the routines used for style checking, as
-- activated by the relevant command line option. These are gathered in
-- a separate package so that they can more easily be customized. Calls
-- to these subprograms are only made if Opt.Style_Check is set True.
with Types; use Types;
package Style is
procedure Body_With_No_Spec (N : Node_Id);
-- Called where N is a subprogram body node for a subprogram body
-- for which no spec was given, i.e. a body acting as its own spec.
procedure Check_Abs_Not;
-- Called after scanning an ABS or NOT operator to check spacing
procedure Check_Arrow;
-- Called after scanning out an arrow to check spacing
procedure Check_Attribute_Name (Reserved : Boolean);
-- The current token is an attribute designator. Check that it is
-- capitalized in an appropriate manner. Reserved is set if the
-- attribute designator is a reserved word (access, digits, delta
-- or range) to allow differing rules for the two cases.
procedure Check_Box;
-- Called after scanning out a box to check spacing
procedure Check_Binary_Operator;
-- Called after scanning out a binary operator other than a plus, minus
-- or exponentiation operator. Intended for checking spacing rules.
procedure Check_Exponentiation_Operator;
-- Called after scanning out an exponentiation operator. Intended for
-- checking spacing rules.
procedure Check_Colon;
-- Called after scanning out colon to check spacing
procedure Check_Colon_Equal;
-- Called after scanning out colon equal to check spacing
procedure Check_Comma;
-- Called after scanning out comma to check spacing
procedure Check_Comment;
-- Called with Scan_Ptr pointing to the first minus sign of a comment.
-- Intended for checking any specific rules for comment placement/format.
procedure Check_Dot_Dot;
-- Called after scanning out dot dot to check spacing
procedure Check_HT;
-- Called with Scan_Ptr pointing to a horizontal tab character
procedure Check_Identifier
(Ref : Node_Or_Entity_Id;
Def : Node_Or_Entity_Id);
-- Check style of identifier occurrence. Ref is an N_Identifier node whose
-- spelling is to be checked against the Chars spelling in identifier node
-- Def (which may be either an N_Identifier, or N_Defining_Identifier node)
procedure Check_Indentation;
-- Called at the start of a new statement or declaration, with Token_Ptr
-- pointing to the first token of the statement or declaration. The check
-- is that the starting column is appropriate to the indentation rules if
-- Token_Ptr is the first token on the line.
procedure Check_Left_Paren;
-- Called after scanning out a left parenthesis to check spacing.
procedure Check_Line_Terminator (Len : Int);
-- Called with Scan_Ptr pointing to the first line terminator terminating
-- the current line, used to check for appropriate line terminator and
-- to check the line length (Len is the length of the current line).
-- Note that the terminator may be the EOF character.
procedure Check_Pragma_Name;
-- The current token is a pragma identifier. Check that it is spelled
-- properly (i.e. with an appropriate casing convention).
procedure Check_Right_Paren;
-- Called after scanning out a right parenthesis to check spacing.
procedure Check_Semicolon;
-- Called after scanning out a semicolon to check spacing
procedure Check_Then (If_Loc : Source_Ptr);
-- Called to check that THEN and IF keywords are appropriately positioned.
-- The parameters show the first characters of the two keywords. This
-- procedure is called only if THEN appears at the start of a line with
-- Token_Ptr pointing to the THEN keyword.
procedure Check_Unary_Plus_Or_Minus;
-- Called after scanning a unary plus or minus to check spacing
procedure Check_Vertical_Bar;
-- Called after scanning a vertical bar to check spacing
procedure No_End_Name (Name : Node_Id);
-- Called if an END is encountered where a name is allowed but not present.
-- The parameter is the node whose name is the name that is permitted in
-- the END line, and the scan pointer is positioned so that if an error
-- message is to be generated in this situation, it should be generated
-- using Error_Msg_SP.
procedure No_Exit_Name (Name : Node_Id);
-- Called when exiting a named loop, but a name is not present on the EXIT.
-- The parameter is the node whose name should have followed EXIT, and the
-- scan pointer is positioned so that if an error message is to be
-- generated, it should be generated using Error_Msg_SP.
procedure Non_Lower_Case_Keyword;
-- Called if a reserved keyword is scanned which is not spelled in all
-- lower case letters. On entry Token_Ptr points to the keyword token.
-- This is not used for keywords appearing as attribute designators,
-- where instead Check_Attribute_Name (True) is called.
function RM_Column_Check return Boolean;
pragma Inline (RM_Column_Check);
-- Determines whether style checking is active and the RM column check
-- mode is set requiring checking of RM format layout.
procedure Subprogram_Not_In_Alpha_Order (Name : Node_Id);
-- Called if Name is the name of a subprogram body in a package body
-- that is not in alphabetical order.
end Style;
gcc/ada/stylesw.adb 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S T Y L E S W --
-- --
-- B o d y --
-- --
-- $Revision: 1.14 $
-- --
-- Copyright (C) 1992-2001, 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
with Hostparm; use Hostparm;
with Opt; use Opt;
package body Stylesw is
-------------------------------
-- Reset_Style_Check_Options --
-------------------------------
procedure Reset_Style_Check_Options is
begin
Style_Check_Indentation := 0;
Style_Check_Attribute_Casing := False;
Style_Check_Blanks_At_End := False;
Style_Check_Comments := False;
Style_Check_End_Labels := False;
Style_Check_Form_Feeds := False;
Style_Check_Horizontal_Tabs := False;
Style_Check_If_Then_Layout := False;
Style_Check_Keyword_Casing := False;
Style_Check_Layout := False;
Style_Check_Max_Line_Length := False;
Style_Check_Pragma_Casing := False;
Style_Check_References := False;
Style_Check_Specs := False;
Style_Check_Standard := False;
Style_Check_Subprogram_Order := False;
Style_Check_Tokens := False;
end Reset_Style_Check_Options;
------------------------------
-- Save_Style_Check_Options --
------------------------------
procedure Save_Style_Check_Options (Options : out Style_Check_Options) is
P : Natural := 0;
J : Natural;
procedure Add (C : Character; S : Boolean);
-- Add given character C to string if switch S is true
procedure Add (C : Character; S : Boolean) is
begin
if S then
P := P + 1;
Options (P) := C;
end if;
end Add;
-- Start of processing for Save_Style_Check_Options
begin
for K in Options'Range loop
Options (K) := ' ';
end loop;
Add (Character'Val (Style_Check_Indentation + Character'Pos ('0')),
Style_Check_Indentation /= 0);
Add ('a', Style_Check_Attribute_Casing);
Add ('b', Style_Check_Blanks_At_End);
Add ('c', Style_Check_Comments);
Add ('e', Style_Check_End_Labels);
Add ('f', Style_Check_Form_Feeds);
Add ('h', Style_Check_Horizontal_Tabs);
Add ('i', Style_Check_If_Then_Layout);
Add ('k', Style_Check_Keyword_Casing);
Add ('l', Style_Check_Layout);
Add ('m', Style_Check_Max_Line_Length);
Add ('n', Style_Check_Standard);
Add ('o', Style_Check_Subprogram_Order);
Add ('p', Style_Check_Pragma_Casing);
Add ('r', Style_Check_References);
Add ('s', Style_Check_Specs);
Add ('t', Style_Check_Tokens);
if Style_Check_Max_Line_Length then
P := Options'Last;
J := Natural (Style_Max_Line_Length);
loop
Options (P) := Character'Val (J mod 10 + Character'Pos ('0'));
P := P - 1;
J := J / 10;
exit when J = 0;
end loop;
Options (P) := 'M';
end if;
end Save_Style_Check_Options;
-------------------------------------
-- Set_Default_Style_Check_Options --
-------------------------------------
procedure Set_Default_Style_Check_Options is
begin
Reset_Style_Check_Options;
Set_Style_Check_Options ("3abcefhiklmnprst");
end Set_Default_Style_Check_Options;
-----------------------------
-- Set_Style_Check_Options --
-----------------------------
-- Version used when no error checking is required
procedure Set_Style_Check_Options (Options : String) is
OK : Boolean;
EC : Natural;
begin
Set_Style_Check_Options (Options, OK, EC);
end Set_Style_Check_Options;
-- Normal version with error checking
procedure Set_Style_Check_Options
(Options : String;
OK : out Boolean;
Err_Col : out Natural)
is
J : Natural;
C : Character;
begin
J := Options'First;
while J <= Options'Last loop
C := Options (J);
J := J + 1;
case C is
when '1' .. '9' =>
Style_Check_Indentation
:= Character'Pos (C) - Character'Pos ('0');
when 'a' =>
Style_Check_Attribute_Casing := True;
when 'b' =>
Style_Check_Blanks_At_End := True;
when 'c' =>
Style_Check_Comments := True;
when 'e' =>
Style_Check_End_Labels := True;
when 'f' =>
Style_Check_Form_Feeds := True;
when 'h' =>
Style_Check_Horizontal_Tabs := True;
when 'i' =>
Style_Check_If_Then_Layout := True;
when 'k' =>
Style_Check_Keyword_Casing := True;
when 'l' =>
Style_Check_Layout := True;
when 'm' =>
Style_Check_Max_Line_Length := True;
Style_Max_Line_Length := 79;
when 'n' =>
Style_Check_Standard := True;
when 'M' =>
Style_Max_Line_Length := 0;
if J > Options'Last
or else Options (J) not in '0' .. '9'
then
OK := False;
Err_Col := J;
return;
end if;
loop
Style_Max_Line_Length :=
Style_Max_Line_Length * 10 +
Character'Pos (Options (J)) - Character'Pos ('0');
J := J + 1;
exit when J > Options'Last
or else Options (J) not in '0' .. '9';
end loop;
Style_Max_Line_Length :=
Int'Min (Style_Max_Line_Length, Hostparm.Max_Line_Length);
Style_Check_Max_Line_Length := Style_Max_Line_Length /= 0;
when 'o' =>
Style_Check_Subprogram_Order := True;
when 'p' =>
Style_Check_Pragma_Casing := True;
when 'r' =>
Style_Check_References := True;
when 's' =>
Style_Check_Specs := True;
when 't' =>
Style_Check_Tokens := True;
when ' ' =>
null;
when others =>
OK := False;
Err_Col := J - 1;
return;
end case;
end loop;
Style_Check := True;
OK := True;
Err_Col := Options'Last + 1;
end Set_Style_Check_Options;
end Stylesw;
gcc/ada/switch.ads 0 → 100644
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S W I T C H --
-- --
-- S p e c --
-- --
-- $Revision: 1.17 $ --
-- --
-- Copyright (C) 1992-2001 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- This package scans switches. Note that the body of Usage must be
-- coordinated with the switches that are recognized by this package.
-- The Usage package also acts as the official documentation for the
-- switches that are recognized. In addition, package Debug documents
-- the otherwise undocumented debug switches that are also recognized.
package Switch is
-- Note: The default switch character is indicated by Switch_Character,
-- but regardless of what it is, a hyphen is always allowed as an
-- (alternative) switch character.
-- Note: In GNAT, the case of switches is not significant if
-- Switches_Case_Sensitive is False. If this is the case, switch
-- characters, or letters appearing in the parameter to a switch, may be
-- either upper case or lower case.
-----------------
-- Subprograms --
-----------------
function Is_Switch (Switch_Chars : String) return Boolean;
-- Returns True iff Switch_Chars is at least two characters long,
-- and the first character indicates it is a switch.
function Is_Front_End_Switch (Switch_Chars : String) return Boolean;
-- Returns True iff Switch_Chars represents a front-end switch,
-- ie. it starts with -I or -gnat.
procedure Scan_Front_End_Switches (Switch_Chars : String);
procedure Scan_Binder_Switches (Switch_Chars : String);
procedure Scan_Make_Switches (Switch_Chars : String);
-- Procedures to scan out switches stored in the given string. The first
-- character is known to be a valid switch character, and there are no
-- blanks or other switch terminator characters in the string, so the
-- entire string should consist of valid switch characters, except that
-- an optional terminating NUL character is allowed. A bad switch causes
-- a fatal error exit and control does not return. The call also sets
-- Usage_Requested to True if a ? switch is encountered.
end Switch;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment