-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
with Lib; use Lib;
with Osint; use Osint;
with Opt; use Opt;
-with Osint; use Osint;
with Osint.C; use Osint.C;
with Namet; use Namet;
with Nlists; use Nlists;
with Csets; use Csets;
with Namet; use Namet;
with Opt; use Opt;
-with Types; use Types;
with Widechar; use Widechar;
package body Casing is
with SFN_Scan; use SFN_Scan;
with Namet; use Namet;
with Osint; use Osint;
-with Types; use Types;
with Unchecked_Conversion;
with Ada.Unchecked_Conversion;
package body GNAT.Debug_Pools is
- use System;
- use System.Storage_Elements;
Default_Alignment : constant Storage_Offset := Standard'Maximum_Alignment;
-- Alignment used for the memory chunks returned by Allocate. Using this
Display_Slots : Boolean := False;
Display_Leaks : Boolean := False)
is
- use System.Storage_Elements;
package Backtrace_Htable_Cumulate is new GNAT.HTable.Static_HTable
(Header_Num => Header,
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- --
------------------------------------------------------------------------------
-with Ada.Exceptions; use Ada.Exceptions;
with Ada.Unchecked_Conversion;
with System;
with System.Soft_Links; use System.Soft_Links;
-- we use the one stack approach developed in the SPITBOL implementation.
with Ada.Exceptions; use Ada.Exceptions;
-with Ada.Strings.Maps; use Ada.Strings.Maps;
with Ada.Strings.Unbounded.Aux; use Ada.Strings.Unbounded.Aux;
with GNAT.Debug_Utilities; use GNAT.Debug_Utilities;
type PE (Pcode : Pattern_Code) is record
Index : IndexT;
- -- Serial index number of pattern element within pattern.
+ -- Serial index number of pattern element within pattern
Pthen : PE_Ptr;
-- Successor element, to be matched after this one
-- pointer to Y node, which is the PC_Arb_Y node that matches one
-- extra character and restacks itself.
- -- The PC_Arb_X node is numbered 2, and the PC_Arb_Y node is 1.
+ -- The PC_Arb_X node is numbered 2, and the PC_Arb_Y node is 1
-------------------------
-- Arbno (simple case) --
function Is_In (C : Character; Str : String) return Boolean;
pragma Inline (Is_In);
- -- Determines if the character C is in string Str.
+ -- Determines if the character C is in string Str
procedure Logic_Error;
-- Called to raise Program_Error with an appropriate message if an
-- | Y |---->
-- +---+
- -- The PC_Arb_X element is numbered 2, and the PC_Arb_Y element is 1.
+ -- The PC_Arb_X element is numbered 2, and the PC_Arb_Y element is 1
function Arb return Pattern is
Y : constant PE_Ptr := new PE'(PC_Arb_Y, 1, EOP);
-- References to elements in P, indexed by Index field
Copy : Ref_Array (1 .. P.Index);
- -- Holds copies of elements of P, indexed by Index field.
+ -- Holds copies of elements of P, indexed by Index field
E : PE_Ptr;
E : PE_Ptr;
procedure Write_Node_Id (E : PE_Ptr);
- -- Writes out a string identifying the given pattern element.
+ -- Writes out a string identifying the given pattern element
procedure Write_Node_Id (E : PE_Ptr) is
begin
when PC_Alt => Alt : declare
Elmts_In_L : constant IndexT := E.Pthen.Index - E.Alt.Index;
- -- Number of elements in left pattern of alternation.
+ -- Number of elements in left pattern of alternation
Lowest_In_L : constant IndexT := E.Index - Elmts_In_L;
-- Number of lowest index in elements of left pattern
-- failure and popping a "real" cursor value from the stack.
PE_Unanchored : aliased PE := (PC_Unanchored, 0, Pat_P);
- -- Dummy pattern element used in the unanchored case.
+ -- Dummy pattern element used in the unanchored case
Stack : Stack_Type;
-- The pattern matching failure stack for this call to Match
when PC_Assign =>
goto Fail;
- -- Assign immediate. This node performs the actual assignment.
+ -- Assign immediate. This node performs the actual assignment
when PC_Assign_Imm =>
Set_String
-- failure and popping a "real" cursor value from the stack.
PE_Unanchored : aliased PE := (PC_Unanchored, 0, Pat_P);
- -- Dummy pattern element used in the unanchored case.
+ -- Dummy pattern element used in the unanchored case
Region_Level : Natural := 0;
-- Keeps track of recursive region level. This is used only for
-- successful match.
procedure Dout (Str : String);
- -- Output string to standard error with bars indicating region level.
+ -- Output string to standard error with bars indicating region level
procedure Dout (Str : String; A : Character);
-- Calls Dout with the string S ('A')
Dout (Img (Node) & "deferred assign/write cancelled");
goto Fail;
- -- Assign immediate. This node performs the actual assignment.
+ -- Assign immediate. This node performs the actual assignment
when PC_Assign_Imm =>
Dout
-- language is modeled on context free grammars, with context sensitive
-- extensions that provide full (type 0) computational capabilities.
-with Ada.Finalization; use Ada.Finalization;
with Ada.Strings.Maps; use Ada.Strings.Maps;
with Ada.Text_IO; use Ada.Text_IO;
package GNAT.Spitbol.Patterns is
-pragma Elaborate_Body (Patterns);
+ pragma Elaborate_Body;
-------------------------------
-- Pattern Matching Tutorial --
-- Abort Cancel
-- Rem Rest
- -- where we have clashes with Ada reserved names.
+ -- where we have clashes with Ada reserved names
-- Ada requires the use of 'Access to refer to functions used in the
-- pattern match, and often the use of 'Unrestricted_Access may be
function "&" (L : PChar; R : Pattern) return Pattern;
function "&" (L : Pattern; R : PChar) return Pattern;
- -- Pattern concatenation. Matches L followed by R.
+ -- Pattern concatenation. Matches L followed by R
function "or" (L : Pattern; R : Pattern) return Pattern;
function "or" (L : PString; R : Pattern) return Pattern;
-- Constructs a pattern that immediately aborts the entire match
function Fail return Pattern;
- -- Constructs a pattern that always fails.
+ -- Constructs a pattern that always fails
function Fence return Pattern;
-- Constructs a pattern that matches null on the first attempt, and then
-- except that instead of setting the value of a variable, the matched
-- substring is written to the appropriate file. This can be useful in
-- following the progress of a match without generating the full amount
-
-- of information obtained by setting Debug_Mode to True.
Terminal : constant File_Access := Standard_Error;
Output : constant File_Access := Standard_Output;
- -- Two handy synonyms for use with the above pattern write operations.
+ -- Two handy synonyms for use with the above pattern write operations
-- Finally we have some routines that are useful for determining what
-- patterns are in use, particularly if they are constructed dynamically.
-- Maximum number of stack entries required for matching this
-- pattern. See description of pattern history stack in body.
- P : PE_Ptr := null;
+ P : PE_Ptr := null;
-- Pointer to initial pattern element for pattern
end record;
-- Adjust routine used to copy pattern objects
procedure Finalize (Object : in out Pattern);
- -- Finalization routine used to release storage allocated for a pattern.
+ -- Finalization routine used to release storage allocated for a pattern
type VString_Ptr is access all VString;
type Match_Result is record
- Var : VString_Ptr;
- -- Pointer to subject string. Set to null if match failed.
+ Var : VString_Ptr;
+ -- Pointer to subject string. Set to null if match failed
Start : Natural := 1;
-- Starting index position (1's origin) of matched section of
-- subject string. Only valid if Var is non-null.
- Stop : Natural := 0;
+ Stop : Natural := 0;
-- Ending index position (1's origin) of matched section of
-- subject string. Only valid if Var is non-null.
----------------
procedure Get_Thread (Id : Address; Thread : Address) is
- use System.OS_Interface;
Thr : constant Thread_Id_Ptr := To_Thread (Thread);
begin
Thr.all := Task_Primitives.Operations.Get_Thread_Id (To_Id (Id));
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- --
------------------------------------------------------------------------------
-with Output; use Output;
-
separate (Lib)
procedure List (File_Names_Only : Boolean := False) is
declare
Archive : Ada.Text_IO.File_Type;
- use Ada.Text_IO;
begin
Create (Archive, Out_File, Archive_Name);
Close (Archive);
Source_Id : Other_Source_Id := First_Source;
Source : Other_Source;
Dep_File : Ada.Text_IO.File_Type;
- use Ada.Text_IO;
begin
-- Create the file in Append mode, to avoid automatic insertion of
Source : Other_Source;
Dep_File : Ada.Text_IO.File_Type;
- use Ada.Text_IO;
-
begin
-- Create the file in Append mode, to avoid automatic insertion of
-- an end of line if file is empty.
with Namet; use Namet;
with Osint; use Osint;
-with Prj; use Prj;
with Prj.Ext;
with Prj.Util;
with Snames; use Snames;
with Table;
-with Types; use Types;
with System.HTable;
-- In the default version, libraries are not supported, so function
-- Support_For_Libraries return None.
-with GNAT.OS_Lib; use GNAT.OS_Lib;
with Prj; use Prj;
package MLib.Tgt is
with MLib.Utl; use MLib.Utl;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
-with GNAT.OS_Lib; use GNAT.OS_Lib;
package body MLib is
is
pragma Warnings (Off, Afiles);
- use GNAT.OS_Lib;
-
begin
if not Opt.Quiet_Output then
Write_Line ("building a library...");
with Unchecked_Conversion;
-with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.HTable;
package body Osint is
-- Turn off subprogram body ordering check. Subprograms are in order
-- by RM section rather than alphabetical
-with Fname; use Fname;
with Fname.UF; use Fname.UF;
with Uname; use Uname;
-- and parents of subunits. All these units are loaded and pointers installed
-- in the tree as described in the spec of package Lib.
-with Fname; use Fname;
with Fname.UF; use Fname.UF;
with Lib.Load; use Lib.Load;
with Uname; use Uname;
-with Namet; use Namet;
-with Casing; use Casing;
-with Opt; use Opt;
with Osint; use Osint;
with Sinput.L; use Sinput.L;
with Stylesw; use Stylesw;
return;
end if;
- -- If current unit is a child unit spec, load its parent
- -- If the child unit is loaded through a limited with, the parent
- -- must be as well.
+ -- If current unit is a child unit spec, load its parent. If the child unit
+ -- is loaded through a limited with, the parent must be as well.
- elsif Nkind (Unit (Curunit)) = N_Package_Declaration
+ elsif Nkind (Unit (Curunit)) = N_Package_Declaration
or else Nkind (Unit (Curunit)) = N_Subprogram_Declaration
or else Nkind (Unit (Curunit)) in N_Generic_Declaration
or else Nkind (Unit (Curunit)) in N_Generic_Instantiation
if Spec_Name /= No_Name then
Unum :=
Load_Unit
- (Load_Name => Spec_Name,
- Required => True,
- Subunit => False,
- Error_Node => Curunit,
+ (Load_Name => Spec_Name,
+ Required => True,
+ Subunit => False,
+ Error_Node => Curunit,
From_Limited_With => From_Limited_With);
if Unum /= No_Unit then
with Sinput;
with Stringt; use Stringt;
with Table;
-with Types; use Types;
with GNAT.Heap_Sort_G;
-- --
-- S p e c --
-- --
--- Copyright (C) 2004 Free Software Foundation, Inc. --
+-- Copyright (C) 2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- --
------------------------------------------------------------------------------
-with Types; use Types;
-
package Prj.Attr.PM is
-- The following procedures are not secure and should only be used by the
-- Project Manager, that is the packages of the Prj or MLib hierarchies.
-- It is also possible to define new packages with their attributes.
with Table;
-with Types; use Types;
package Prj.Attr is
-- This package implements services for Project-aware tools, mostly related
-- to the environment (configuration pragma files, path files, mapping files).
-with GNAT.OS_Lib; use GNAT.OS_Lib;
-
package Prj.Env is
procedure Initialize;
with Namet; use Namet;
with Output; use Output;
-with Scans; use Scans;
with Stringt; use Stringt;
package body Prj.Err is
-- --
-- S p e c --
-- --
--- Copyright (C) 2002-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 2002-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
with Scng;
with Errutil;
-with Types; use Types;
package Prj.Err is
-- --
-- B o d y --
-- --
--- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
with Namet; use Namet;
with Osint; use Osint;
with Sdefault;
-with Types; use Types;
-
with GNAT.HTable;
-with GNAT.OS_Lib; use GNAT.OS_Lib;
package body Prj.Ext is
-- --
-- S p e c --
-- --
--- Copyright (C) 2000-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 2000-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- Subprograms to set, get and cache external references, to be used as
-- External functions in project files.
-with Types; use Types;
-
package Prj.Ext is
function Project_Path return String;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
-with GNAT.OS_Lib; use GNAT.OS_Lib;
with GNAT.Regexp; use GNAT.Regexp;
with System.Case_Util; use System.Case_Util;
-- --
-- S p e c --
-- --
--- Copyright (C) 2001-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2005 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- --
-- For arbitrary naming schemes, create or update a project file,
-- or create a configuration pragmas file.
-with GNAT.OS_Lib; use GNAT.OS_Lib;
-
package Prj.Makr is
procedure Make
-- Implements the parsing of project files
-with GNAT.OS_Lib; use GNAT.OS_Lib;
-
package Prj.Pars is
procedure Set_Verbosity (To : Verbosity);
with Prj.Dect;
with Prj.Err; use Prj.Err;
with Prj.Ext; use Prj.Ext;
-with Scans; use Scans;
with Sinput; use Sinput;
with Sinput.P; use Sinput.P;
with Snames;
with Table;
-with Types; use Types;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Exceptions; use Ada.Exceptions;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
-with GNAT.OS_Lib; use GNAT.OS_Lib;
with System.HTable; use System.HTable;
-pragma Elaborate_All (GNAT.OS_Lib);
-
package body Prj.Part is
Buffer : String_Access;
with Namet; use Namet;
with Prj.Attr; use Prj.Attr;
with Prj.Err; use Prj.Err;
-with Prj.Tree; use Prj.Tree;
-with Scans; use Scans;
with Snames;
with Table;
-with Types; use Types;
with Uintp; use Uintp;
package body Prj.Strt is
with GNAT.Dynamic_Tables;
with Prj.Attr; use Prj.Attr;
-with Types; use Types;
package Prj.Tree is
-- Utilities for use in processing project files
-with Types; use Types;
-
-with GNAT.OS_Lib; use GNAT.OS_Lib;
-
package Prj.Util is
function Executable_Of
with Prj.Attr;
with Prj.Env;
with Prj.Err; use Prj.Err;
-with Scans; use Scans;
with Snames; use Snames;
with Uintp; use Uintp;
with GNAT.Case_Util; use GNAT.Case_Util;
-with GNAT.OS_Lib; use GNAT.OS_Lib;
package body Prj is
with Sem_Res; use Sem_Res;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
-with Snames; use Snames;
with Stand; use Stand;
with Stringt; use Stringt;
with Tbuild; use Tbuild;
-----------------------
procedure RAS_E_Dereference (Pref : Node_Id);
- -- Handles explicit dereference of Remote Access to Subprograms.
+ -- Handles explicit dereference of Remote Access to Subprograms
function Full_Qualified_Name (E : Entity_Id) return String_Id;
- -- returns the full qualified name of the entity in lower case.
+ -- returns the full qualified name of the entity in lower case
-------------------------
-- Add_Stub_Constructs --
Ent := Defining_Identifier (Ent);
end if;
- -- Compute recursively the qualification. Only "Standard" has no scope.
+ -- Compute recursively the qualification (only "Standard" has no scope)
if Present (Scope (Scope (Ent))) then
Parent_Name := Full_Qualified_Name (Scope (Ent));
end if;
- -- Every entity should have a name except some expanded blocks
- -- don't bother about those.
+ -- Every entity should have a name except some expanded blocks. Do not
+ -- bother about those.
if Chars (Ent) = No_Name then
return Parent_Name;
Ety := Scope (Ety);
end loop;
- -- Retrieve the proper function to call.
+ -- Retrieve the proper function to call
if Is_Remote_Call_Interface (Ety) then
Get_Pt_Id := New_Occurrence_Of
end loop;
if Is_Degenerate then
- Error_Msg_NE (
- "remote access-to-subprogram type& can only be null?",
- Defining_Identifier (Parameter), User_Type);
+ Error_Msg_NE
+ ("remote access-to-subprogram type& can only be null?",
+ Defining_Identifier (Parameter), User_Type);
+
-- The only legal value for a RAS with a formal parameter of an
- -- anonymous access type is null, because it cannot be
- -- subtype-Conformant with any legal remote subprogram declaration.
- -- In this case, we cannot generate a corresponding primitive
- -- operation.
+ -- anonymous access type is null, because it cannot be subtype-
+ -- conformant with any legal remote subprogram declaration. In this
+ -- case, we cannot generate a corresponding primitive operation.
end if;
if Get_PCS_Name = Name_No_DSA then
return;
end if;
- -- The tagged private type, primitive operation and RACW
- -- type associated with a RAS need to all be declared in
- -- a subpackage of the one that contains the RAS declaration,
- -- because the primitive of the object type, and the associated
- -- primitive of the stub type, need to be dispatching operations
- -- of these types, and the profile of the RAS might contain
- -- tagged types declared in the same scope.
+ -- The tagged private type, primitive operation and RACW type associated
+ -- with a RAS need to all be declared in a subpackage of the one that
+ -- contains the RAS declaration, because the primitive of the object
+ -- type, and the associated primitive of the stub type, need to be
+ -- dispatching operations of these types, and the profile of the RAS
+ -- might contain tagged types declared in the same scope.
Append_To (Vis_Decls,
Make_Private_Type_Declaration (Loc,
end if;
else
- -- Context is not a call.
+ -- Context is not a call
return;
end if;
-- It is used by Sinput.P to load project files, and by GPrep to load
-- preprocessor definition files and input files.
-with Types; use Types;
-
package Sinput.C is
function Load_File (Path : String) return Source_File_Index;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005, 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- --
-- 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
------------------------------------------
-- routines to save and restore a project scan context.
with Scans; use Scans;
-with Types; use Types;
package Sinput.P is
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2005 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- --
-- used by the compiler for style checking. These routines are in a separate
-- package because they depend on the GNAT tree (Atree, Sinfo, ...).
-with Types; use Types;
-
generic
with procedure Error_Msg_N (Msg : String; N : Node_Or_Entity_Id);
-- Output a message at the Sloc of the given node
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2005 Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-------------------------
procedure Create_Project_File (Name : String) is
- use Ada.Strings.Unbounded;
-
Obj_Dir : Unbounded_String := Null_Unbounded_String;
Src_Dir : Unbounded_String := Null_Unbounded_String;
Build_Dir : GNAT.OS_Lib.String_Access := new String'("");
projects / platform / upstream / linaro-gcc.git / commitdiff