Thread_Blocking_IO : Boolean := True;
Unknown_System_Error : constant C.Strings.chars_ptr :=
- C.Strings.New_String ("Unknown system error");
+ C.Strings.New_String ("Unknown system error");
-- The following types and variables are required to create a Hostent
-- record "by hand".
procedure Abort_Handler (signo : Signal) is
pragma Unreferenced (signo);
- Self_Id : Task_ID := Self;
+ Self_Id : constant Task_ID := Self;
Result : Interfaces.C.int;
Old_Set : aliased sigset_t;
+2004-01-13 Ed Schonberg <schonberg@gnat.com>
+
+ * exp_ch3.adb (Build_Assignment): Fix bug in handling of controlled
+ components that are initialized with aggregates.
+
+2004-01-13 Vincent Celier <celier@gnat.com>
+
+ * gnatlink.adb (Process_Binder_File): To find directory of shared
+ libgcc, if "gcc-lib" is not a subdirectory, look for the last
+ subdirectory "lib" in the path of the shared libgnat or libgnarl.
+
+ * make.adb (Gnatmake): If GCC version is at least 3, link with
+ -shared-libgcc, when there is at least one shared library project.
+
+ * opt.ads (GCC_Version): New integer constant.
+
+ * adaint.c (get_gcc_version): New function.
+
+2004-01-13 Robert Dewar <dewar@gnat.com>
+
+ * sem_dist.adb, sem_res.adb, sem_util.adb,
+ sprint.adb, 3zsocthi.adb, einfo.adb, cstand.adb,
+ exp_ch4.adb, exp_ch9.adb, exp_dist.adb: Minor reformatting
+
+2004-01-13 Thomas Quinot <quinot@act-europe.fr>
+
+ * s-interr.adb, s-stache.adb, s-taenca.adb, g-regpat.adb,
+ g-spitbo.adb, 5itaprop.adb: Add missing 'constant' keywords in object
+ declarations.
+
2004-01-12 Arnaud Charlet <charlet@act-europe.fr>
* misc.c: Remove trailing spaces.
* *
* C Implementation File *
* *
- * Copyright (C) 1992-2003, Free Software Foundation, Inc. *
+ * Copyright (C) 1992-2004, 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- *
{
return (int) lseek (fd, offset, whence);
}
+
+/* This function returns the version of GCC being used. Here it's GCC 3. */
+int
+get_gcc_version (void)
+{
+ return 3;
+}
+
-- Create type definition node for type String
Tdef_Node := New_Node (N_Unconstrained_Array_Definition, Stloc);
+
declare
CompDef_Node : Node_Id;
begin
Set_Subtype_Indication (CompDef_Node, Identifier_For (S_Character));
Set_Component_Definition (Tdef_Node, CompDef_Node);
end;
+
Set_Subtype_Marks (Tdef_Node, New_List);
Append (Identifier_For (S_Positive), Subtype_Marks (Tdef_Node));
Set_Type_Definition (Parent (Standard_String), Tdef_Node);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004 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 CPARTICULAR PURPOSE. See the GNU General Public License --
+-- 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, --
-- aggregate that will be expanded inline
if Kind = N_Qualified_Expression then
- Kind := Nkind (Parent (N));
+ Kind := Nkind (Expression (N));
end if;
if Controlled_Type (Typ)
Comp : RE_Id;
- Stg_Unit_Is_Byte : constant Boolean := System_Storage_Unit = Byte'Size;
+ Byte_Addressable : constant Boolean := System_Storage_Unit = Byte'Size;
+ -- True for byte addressable target
function Length_Less_Than_4 (Opnd : Node_Id) return Boolean;
-- Returns True if the length of the given operand is known to be
-- addressing of array components.
if not Is_Bit_Packed_Array (Typ1)
- and then Stg_Unit_Is_Byte
+ and then Byte_Addressable
and then not Java_VM
then
-- The call we generate is:
(Parent (Efam)))), Loc))),
Component_Definition =>
- Make_Component_Definition (Loc,
- Aliased_Present => False,
- Subtype_Indication =>
- New_Reference_To (Standard_Character, Loc))));
+ Make_Component_Definition (Loc,
+ Aliased_Present => False,
+ Subtype_Indication =>
+ New_Reference_To (Standard_Character, Loc))));
Insert_After (Current_Node, Efam_Decl);
Current_Node := Efam_Decl;
Component_Definition =>
Make_Component_Definition (Loc,
Aliased_Present => False,
+
Subtype_Indication =>
Make_Subtype_Indication (Loc,
Subtype_Mark =>
New_Occurrence_Of (Efam_Type, Loc),
+
Constraint =>
Make_Index_Or_Discriminant_Constraint (Loc,
Constraints => New_List (
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Defining_Identifier (Loc, Name_uTask_Info),
+
Component_Definition =>
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
New_Reference_To (RTE (RE_Task_Info_Type), Loc)),
+
Expression => New_Copy (
Expression (First (
Pragma_Argument_Associations (
-- The following model has been used to implement distributed objects:
-- given a designated type D and a RACW type R, then a record of the
-- form:
+
-- type Stub is tagged record
-- [...declaration similar to s-parint.ads RACW_Stub_Type...]
-- end record;
+
-- is built. This type has two properties:
- --
+
-- 1) Since it has the same structure than RACW_Stub_Type, it can be
-- converted to and from this type to make it suitable for
-- System.Partition_Interface.Get_Unique_Remote_Pointer in order
-- to avoid memory leaks when the same remote object arrive on the
-- same partition by following different pathes
- --
+
-- 2) It also has the same dispatching table as the designated type D,
-- and thus can be used as an object designated by a value of type
-- R on any partition other than the one on which the object has
function Match_Whilem (IP : Pointer) return Boolean is
pragma Unreferenced (IP);
- Cc : Current_Curly_Access := Current_Curly;
- N : constant Natural := Cc.Cur + 1;
- Ln : Natural := 0;
+ Cc : constant Current_Curly_Access := Current_Curly;
+ N : constant Natural := Cc.Cur + 1;
+ Ln : Natural := 0;
Lastloc : constant Natural := Cc.Lastloc;
-- Detection of 0-len.
procedure Reverse_String (Str : in out VString) is
Len : constant Natural := Length (Str);
- Chars : String_Access := Get_String (Str);
+ Chars : constant String_Access := Get_String (Str);
Temp : Character;
begin
-- terminator.
function Index (S, Pattern : String) return Natural;
- -- Return the first occurrence of Pattern in S, or 0 if none.
+ -- Return the last occurrence of Pattern in S, or 0 if none.
function Is_Option_Present (Opt : in String) return Boolean;
-- Return true if the option Opt is already present in
function Index (S, Pattern : String) return Natural is
Len : constant Natural := Pattern'Length;
+
begin
- for J in S'First .. S'Last - Len + 1 loop
+ for J in reverse S'First .. S'Last - Len + 1 loop
if Pattern = S (J .. J + Len - 1) then
return J;
end if;
-- Also add path to find libgcc_s.so, if
-- relevant.
- GCC_Index := Index (File_Path.all, "gcc-lib");
+ -- To find the location of the shared version
+ -- of libgcc, we look for "gcc-lib" in the
+ -- path of the library. However, this
+ -- subdirectory is no longer present in
+ -- in recent version of GCC. So, we look for
+ -- the last subdirectory "lib" in the path.
+
+ GCC_Index :=
+ Index (File_Path.all, "gcc-lib");
+
+ if GCC_Index /= 0 then
+ -- The shared version of libgcc is
+ -- located in the parent directory.
+
+ GCC_Index := GCC_Index - 1;
+
+ else
+ GCC_Index :=
+ Index (File_Path.all, "/lib/");
+
+ if GCC_Index = 0 then
+ GCC_Index :=
+ Index (File_Path.all,
+ Directory_Separator &
+ "lib" &
+ Directory_Separator);
+ end if;
+
+ -- We have found a subdirectory "lib",
+ -- this is where the shared version of
+ -- libgcc should be located.
+
+ if GCC_Index /= 0 then
+ GCC_Index := GCC_Index + 3;
+ end if;
+ end if;
-- Look for an eventual run_path_option in
-- the linker switches.
(1 .. File_Path'Length
- File_Name'Length)
& Path_Separator
- & File_Path (1 .. GCC_Index - 1));
+ & File_Path (1 .. GCC_Index));
else
Linker_Options.Table
(1 .. File_Path'Length
- File_Name'Length)
& Path_Separator
- & File_Path (1 .. GCC_Index - 1));
+ & File_Path (1 .. GCC_Index));
end if;
end if;
end if;
Bind_Shared_Known : Boolean := False;
-- Set to True after the first time Bind_Shared is computed
+ Shared_Libgcc : aliased String := "-shared-libgcc";
+
+ No_Shared_Libgcc_Switch : aliased Argument_List := (1 .. 0 => null);
+ Shared_Libgcc_Switch : aliased Argument_List :=
+ (1 => Shared_Libgcc'Access);
+ Link_With_Shared_Libgcc : Argument_List_Access :=
+ No_Shared_Libgcc_Switch'Access;
+
procedure Make_Failed (S1 : String; S2 : String := ""; S3 : String := "");
-- Delete all temp files created by Gnatmake and call Osint.Fail,
-- with the parameter S1, S2 and S3 (see osint.ads).
Make.Initialize;
Bind_Shared := No_Shared_Switch'Access;
+ Link_With_Shared_Libgcc := No_Shared_Libgcc_Switch'Access;
Bind_Shared_Known := False;
Failed_Links.Set_Last (0);
Projects.Table (Proj).Library_Kind /= Static
then
Bind_Shared := Shared_Switch'Access;
+
+ if GCC_Version >= 3 then
+ Link_With_Shared_Libgcc :=
+ Shared_Libgcc_Switch'Access;
+ end if;
+
exit;
end if;
end loop;
-- And invoke the linker
begin
- Link (Main_ALI_File, Args (Args'First .. Last_Arg));
+ Link (Main_ALI_File,
+ Link_With_Shared_Libgcc.all &
+ Args (Args'First .. Last_Arg));
Successful_Links.Increment_Last;
Successful_Links.Table (Successful_Links.Last) :=
Main_ALI_File;
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2004, 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- --
-- GNAT
-- Set True to generate full source listing with embedded errors
+ function get_gcc_version return Int;
+ pragma Import (C, get_gcc_version, "get_gcc_version");
+
+ GCC_Version : constant Nat := get_gcc_version;
+ -- GNATMAKE
+ -- Indicates which version of gcc is in use (2 = 2.8.1, 3 = 3.x).
+ -- Used in particular to decide if gcc switch -shared-libgcc should be
+ -- used (it cannot be used for 2.8.1).
+
Global_Discard_Names : Boolean := False;
-- GNAT, GNATBIND
-- Set true if a pragma Discard_Names applies to the current unit
task body Server_Task is
Intwait_Mask : aliased IMNG.Interrupt_Mask;
Ret_Interrupt : Interrupt_ID;
- Self_ID : Task_ID := Self;
+ Self_ID : constant Task_ID := Self;
Tmp_Handler : Parameterless_Handler;
Tmp_ID : Task_ID;
Tmp_Entry_Index : Task_Entry_Index;
Full_Check :
declare
- My_Stack : Stack_Access := Set_Stack_Info (Cache'Access);
+ My_Stack : constant Stack_Access := Set_Stack_Info (Cache'Access);
-- At this point Stack.all might already be invalid, so
-- it is essential to use our local copy of Stack!
if Ceiling_Violation then
declare
- Current_Task : Task_ID := STPO.Self;
+ Current_Task : constant Task_ID := STPO.Self;
Old_Base_Priority : System.Any_Priority;
begin
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
- New_Reference_To
- (Standard_Integer, Loc))),
+ New_Reference_To (Standard_Integer, Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
- New_Reference_To
- (RTE (RE_Unsigned_64), Loc))),
+ New_Reference_To (RTE (RE_Unsigned_64), Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
- New_Reference_To
- (Standard_Natural, Loc))),
+ New_Reference_To (Standard_Natural, Loc))),
Make_Component_Declaration (Loc,
Defining_Identifier =>
Make_Component_Definition (Loc,
Aliased_Present => False,
Subtype_Indication =>
- New_Reference_To
- (Standard_Boolean, Loc)))))));
+ New_Reference_To (Standard_Boolean, Loc)))))));
Insert_After (N, New_Type_Decl);
Set_Equivalent_Type (User_Type, Fat_Type);
and then Scope (Disc) = Current_Scope
and then not
(Nkind (Parent (P)) = N_Subtype_Indication
- and then
- (Nkind (Parent (Parent (P))) = N_Component_Definition
- or else Nkind (Parent (Parent (P))) = N_Subtype_Declaration)
+ and then
+ (Nkind (Parent (Parent (P))) = N_Component_Definition
+ or else
+ Nkind (Parent (Parent (P))) = N_Subtype_Declaration)
and then Paren_Count (N) = 0)
then
Error_Msg_N
end if;
-- Detect a common beginner error:
+
-- type R (D : Positive := 100) is record
- -- Name: String (1 .. D);
+ -- Name : String (1 .. D);
-- end record;
-- The default value causes an object of type R to be
function Has_Dependent_Constraint (Comp : Entity_Id) return Boolean is
Comp_Decl : constant Node_Id := Parent (Comp);
Subt_Indic : constant Node_Id :=
- Subtype_Indication (Component_Definition (Comp_Decl));
+ Subtype_Indication (Component_Definition (Comp_Decl));
Constr : Node_Id;
Assn : Node_Id;
when N_Component_Definition =>
Set_Debug_Sloc;
+
if Aliased_Present (Node) then
Write_Str_With_Col_Check ("aliased ");
end if;
+
Sprint_Node (Subtype_Indication (Node));
when N_Component_Declaration =>
projects / thirdparty / gcc.git / commitdiff
