Commit c54e9270 authored by charlet's avatar charlet
Browse files

2004-06-28 Robert Dewar <dewar@gnat.com>

	* mlib-tgt-tru64.adb, mlib-tgt-aix.adb, mlib-tgt-irix.adb,
	mlib-tgt-irix.adb, mlib-tgt-hpux.adb, mlib-tgt-linux.adb,
	mlib-tgt-linux.adb, mlib-tgt-solaris.adb, mlib-tgt-solaris.adb,
	mlib-tgt-vms-alpha.adb, mlib-tgt-vms-alpha.adb, mlib-tgt-vms-ia64.adb,
	a-strmap.adb, a-strmap.ads, clean.adb: Minor reformatting

	* exp_util.adb (Is_Possibly_Unaligned_Slice): Completely rewritten, to
	deal with problem of inefficient slices on machines with strict
	alignment, when the slice is a component of a composite.

	* checks.adb (Apply_Array_Size_Check): Do not special case 64-bit
	machines, we need the check there as well.

2004-06-28  Ed Schonberg  <schonberg@gnat.com>

	* exp_ch5.adb (Expand_Assign_Array): Use correct condition to
	determine safe copying direction for overlapping slice assignments
	when component is controlled.

	* sem_ch12.adb (Instantiate_Formal_Package): Implicit operations of a
	formal derived type in the actual for a formal package are visible in
...
parent b9f1cca5
2004-06-28 Robert Dewar <dewar@gnat.com>
* mlib-tgt-tru64.adb, mlib-tgt-aix.adb, mlib-tgt-irix.adb,
mlib-tgt-irix.adb, mlib-tgt-hpux.adb, mlib-tgt-linux.adb,
mlib-tgt-linux.adb, mlib-tgt-solaris.adb, mlib-tgt-solaris.adb,
mlib-tgt-vms-alpha.adb, mlib-tgt-vms-alpha.adb, mlib-tgt-vms-ia64.adb,
a-strmap.adb, a-strmap.ads, clean.adb: Minor reformatting
* exp_util.adb (Is_Possibly_Unaligned_Slice): Completely rewritten, to
deal with problem of inefficient slices on machines with strict
alignment, when the slice is a component of a composite.
* checks.adb (Apply_Array_Size_Check): Do not special case 64-bit
machines, we need the check there as well.
2004-06-28 Ed Schonberg <schonberg@gnat.com>
* exp_ch5.adb (Expand_Assign_Array): Use correct condition to
determine safe copying direction for overlapping slice assignments
when component is controlled.
* sem_ch12.adb (Instantiate_Formal_Package): Implicit operations of a
formal derived type in the actual for a formal package are visible in
the enclosing instance.
2004-06-28 Ed Schonberg <schonberg@gnat.com>
PR ada/15600
* sem_util.adb (Trace_Components): Diagnose properly an illegal
circularity involving a private type whose completion includes a
self-referential component.
(Enter_Name): Use Is_Inherited_Operation to distinguish a source
renaming or an instantiation from an implicit derived operation.
2004-06-28 Pascal Obry <obry@gnat.com>
* mlib-tgt-mingw.adb: (Library_Exists_For): Remove "lib" prefix from
DLL.
(Library_File_Name_For): Idem.
2004-06-28 Matthew Gingell <gingell@gnat.com>
* g-traceb.ads: Add explanatory note on the format of addresses
expected by addr2line.
2004-06-28 Jerome Guitton <guitton@act-europe.fr>
* Makefile.in: Force debugging information on s-tasdeb.adb,
a-except.adb and s-assert.adb needed by the debugger.
2004-06-28 Vincent Celier <celier@gnat.com>
* make.adb (Collect_Arguments_And_Compile): Change Flag1 to
Need_To_Build_Lib.
(Gnatmake): Ditto.
* mlib-prj.adb (Check_Library): Replace Flag1 with Need_To_Build_Lib
* prj.adb: Minor reformatting
(Project_Empty): Change Flag1 to Need_To_Build_Lib. Remove Flag2.
* prj.ads: Comment updates
Minor reformatting
(Project_Data): Change Flag1 to Need_To_Build_Lib.
Remove Flag2: not used.
* prj-dect.adb (Parse_Declarative_Items): Accept "null" as a
declaration.
* gnat_ugn.texi: Put a "null;" declaration in one project file example
* gnat_rm.texi: Document Empty declarations "null;".
* makegpr.adb (Compile_Link_With_Gnatmake): Put the global archives in
front of the linker options.
(Link_Foreign): Put the global archives and the libraries in front of
the linker options.
2004-06-28 Javier Miranda <miranda@gnat.com>
* rtsfind.adb: (Get_Unit_Name): Fix typo in comment
(RTU_Loaded): Code cleanup
(Set_RTU_Loaded): New procedure to register as *loaded* explicitly
withed predefined units.
* rtsfind.ads (Set_RTU_Loaded): New procedure to register as *loaded*
explicitly withed predefined units.
Fix typo in comment
* sem_ch10.adb (Analyze_Compilation_Unit): Register as *loaded*
explicitly withed predefined units.
2004-06-25 Pascal Obry <obry@gnat.com>
* makegpr.adb (Build_Library): Remove parameter Lib_Address and
......
......@@ -1892,6 +1892,28 @@ endif
s-traceb.o : s-traceb.adb
$(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) \
$(NO_SIBLING_ADAFLAGS) $(ADA_INCLUDES) \
$< $(OUTPUT_OPTION)
# force debugging information on s-tasdeb.o so that it is always
# possible to set conditional breakpoints on tasks.
s-tasdeb.o : s-tasdeb.adb s-tasdeb.ads
$(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O0 $(ADA_INCLUDES) \
$< $(OUTPUT_OPTION)
# force debugging information on a-except.o so that it is always
# possible to set conditional breakpoints on exceptions.
# use -O1 otherwise gdb isn't able to get a full backtrace on mips targets.
a-except.o : a-except.adb a-except.ads
$(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O1 -fno-inline \
$(ADA_INCLUDES) $< $(OUTPUT_OPTION)
# force debugging information on s-assert.o so that it is always
# possible to set breakpoint on assert failures.
s-assert.o : s-assert.adb s-assert.ads a-except.ads
$(CC) -c $(ALL_ADAFLAGS) $(FORCE_DEBUG_ADAFLAGS) -O2 $(ADA_INCLUDES) \
$< $(OUTPUT_OPTION)
adadecode.o : adadecode.c adadecode.h
......
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2002 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- --
......@@ -54,7 +54,7 @@ package body Ada.Strings.Maps is
-- "=" --
---------
function "=" (Left, Right : in Character_Set) return Boolean is
function "=" (Left, Right : Character_Set) return Boolean is
begin
return Character_Set_Internal (Left) = Character_Set_Internal (Right);
end "=";
......@@ -63,7 +63,7 @@ package body Ada.Strings.Maps is
-- "and" --
-----------
function "and" (Left, Right : in Character_Set) return Character_Set is
function "and" (Left, Right : Character_Set) return Character_Set is
begin
return Character_Set
(Character_Set_Internal (Left) and Character_Set_Internal (Right));
......@@ -73,7 +73,7 @@ package body Ada.Strings.Maps is
-- "not" --
-----------
function "not" (Right : in Character_Set) return Character_Set is
function "not" (Right : Character_Set) return Character_Set is
begin
return Character_Set (not Character_Set_Internal (Right));
end "not";
......@@ -82,7 +82,7 @@ package body Ada.Strings.Maps is
-- "or" --
----------
function "or" (Left, Right : in Character_Set) return Character_Set is
function "or" (Left, Right : Character_Set) return Character_Set is
begin
return Character_Set
(Character_Set_Internal (Left) or Character_Set_Internal (Right));
......@@ -92,7 +92,7 @@ package body Ada.Strings.Maps is
-- "xor" --
-----------
function "xor" (Left, Right : in Character_Set) return Character_Set is
function "xor" (Left, Right : Character_Set) return Character_Set is
begin
return Character_Set
(Character_Set_Internal (Left) xor Character_Set_Internal (Right));
......@@ -104,8 +104,7 @@ package body Ada.Strings.Maps is
function Is_In
(Element : Character;
Set : Character_Set)
return Boolean
Set : Character_Set) return Boolean
is
begin
return Set (Element);
......@@ -117,8 +116,7 @@ package body Ada.Strings.Maps is
function Is_Subset
(Elements : Character_Set;
Set : Character_Set)
return Boolean
Set : Character_Set) return Boolean
is
begin
return (Elements and Set) = Elements;
......@@ -128,7 +126,7 @@ package body Ada.Strings.Maps is
-- To_Domain --
---------------
function To_Domain (Map : in Character_Mapping) return Character_Sequence
function To_Domain (Map : Character_Mapping) return Character_Sequence
is
Result : String (1 .. Map'Length);
J : Natural;
......@@ -150,8 +148,7 @@ package body Ada.Strings.Maps is
----------------
function To_Mapping
(From, To : in Character_Sequence)
return Character_Mapping
(From, To : Character_Sequence) return Character_Mapping
is
Result : Character_Mapping;
Inserted : Character_Set := Null_Set;
......@@ -183,11 +180,10 @@ package body Ada.Strings.Maps is
-- To_Range --
--------------
function To_Range (Map : in Character_Mapping) return Character_Sequence
function To_Range (Map : Character_Mapping) return Character_Sequence
is
Result : String (1 .. Map'Length);
J : Natural;
begin
J := 0;
for C in Map'Range loop
......@@ -204,7 +200,7 @@ package body Ada.Strings.Maps is
-- To_Ranges --
---------------
function To_Ranges (Set : in Character_Set) return Character_Ranges is
function To_Ranges (Set : Character_Set) return Character_Ranges is
Max_Ranges : Character_Ranges (1 .. Set'Length / 2 + 1);
Range_Num : Natural;
C : Character;
......@@ -214,7 +210,7 @@ package body Ada.Strings.Maps is
Range_Num := 0;
loop
-- Skip gap between subsets.
-- Skip gap between subsets
while not Set (C) loop
exit when C = Character'Last;
......@@ -226,7 +222,7 @@ package body Ada.Strings.Maps is
Range_Num := Range_Num + 1;
Max_Ranges (Range_Num).Low := C;
-- Span a subset.
-- Span a subset
loop
exit when not Set (C) or else C = Character'Last;
......@@ -248,13 +244,9 @@ package body Ada.Strings.Maps is
-- To_Sequence --
-----------------
function To_Sequence
(Set : Character_Set)
return Character_Sequence
is
function To_Sequence (Set : Character_Set) return Character_Sequence is
Result : String (1 .. Character'Pos (Character'Last) + 1);
Count : Natural := 0;
begin
for Char in Set'Range loop
if Set (Char) then
......@@ -270,9 +262,8 @@ package body Ada.Strings.Maps is
-- To_Set --
------------
function To_Set (Ranges : in Character_Ranges) return Character_Set is
function To_Set (Ranges : Character_Ranges) return Character_Set is
Result : Character_Set;
begin
for C in Result'Range loop
Result (C) := False;
......@@ -287,9 +278,8 @@ package body Ada.Strings.Maps is
return Result;
end To_Set;
function To_Set (Span : in Character_Range) return Character_Set is
function To_Set (Span : Character_Range) return Character_Set is
Result : Character_Set;
begin
for C in Result'Range loop
Result (C) := False;
......@@ -304,7 +294,6 @@ package body Ada.Strings.Maps is
function To_Set (Sequence : Character_Sequence) return Character_Set is
Result : Character_Set := Null_Set;
begin
for J in Sequence'Range loop
Result (Sequence (J)) := True;
......@@ -315,7 +304,6 @@ package body Ada.Strings.Maps is
function To_Set (Singleton : Character) return Character_Set is
Result : Character_Set := Null_Set;
begin
Result (Singleton) := True;
return Result;
......@@ -325,9 +313,10 @@ package body Ada.Strings.Maps is
-- Value --
-----------
function Value (Map : in Character_Mapping; Element : in Character)
return Character is
function Value
(Map : Character_Mapping;
Element : Character) return Character
is
begin
return Map (Element);
end Value;
......
......@@ -61,48 +61,44 @@ pragma Preelaborate (Maps);
type Character_Ranges is array (Positive range <>) of Character_Range;
function To_Set (Ranges : in Character_Ranges) return Character_Set;
function To_Set (Ranges : Character_Ranges) return Character_Set;
function To_Set (Span : in Character_Range) return Character_Set;
function To_Set (Span : Character_Range) return Character_Set;
function To_Ranges (Set : in Character_Set) return Character_Ranges;
function To_Ranges (Set : Character_Set) return Character_Ranges;
----------------------------------
-- Operations on Character Sets --
----------------------------------
function "=" (Left, Right : in Character_Set) return Boolean;
function "=" (Left, Right : Character_Set) return Boolean;
function "not" (Right : in Character_Set) return Character_Set;
function "and" (Left, Right : in Character_Set) return Character_Set;
function "or" (Left, Right : in Character_Set) return Character_Set;
function "xor" (Left, Right : in Character_Set) return Character_Set;
function "-" (Left, Right : in Character_Set) return Character_Set;
function "not" (Right : Character_Set) return Character_Set;
function "and" (Left, Right : Character_Set) return Character_Set;
function "or" (Left, Right : Character_Set) return Character_Set;
function "xor" (Left, Right : Character_Set) return Character_Set;
function "-" (Left, Right : Character_Set) return Character_Set;
function Is_In
(Element : in Character;
Set : in Character_Set)
return Boolean;
(Element : Character;
Set : Character_Set) return Boolean;
function Is_Subset
(Elements : in Character_Set;
Set : in Character_Set)
return Boolean;
(Elements : Character_Set;
Set : Character_Set) return Boolean;
function "<="
(Left : in Character_Set;
Right : in Character_Set)
return Boolean
(Left : Character_Set;
Right : Character_Set) return Boolean
renames Is_Subset;
subtype Character_Sequence is String;
-- Alternative representation for a set of character values
function To_Set (Sequence : in Character_Sequence) return Character_Set;
function To_Set (Sequence : Character_Sequence) return Character_Set;
function To_Set (Singleton : Character) return Character_Set;
function To_Set (Singleton : in Character) return Character_Set;
function To_Sequence (Set : in Character_Set) return Character_Sequence;
function To_Sequence (Set : Character_Set) return Character_Sequence;
------------------------------------
-- Character Mapping Declarations --
......@@ -112,9 +108,8 @@ pragma Preelaborate (Maps);
-- Representation for a character to character mapping:
function Value
(Map : in Character_Mapping;
Element : in Character)
return Character;
(Map : Character_Mapping;
Element : Character) return Character;
Identity : constant Character_Mapping;
......@@ -123,19 +118,16 @@ pragma Preelaborate (Maps);
----------------------------
function To_Mapping
(From, To : in Character_Sequence)
return Character_Mapping;
(From, To : Character_Sequence) return Character_Mapping;
function To_Domain
(Map : in Character_Mapping)
return Character_Sequence;
(Map : Character_Mapping) return Character_Sequence;
function To_Range
(Map : in Character_Mapping)
return Character_Sequence;
(Map : Character_Mapping) return Character_Sequence;
type Character_Mapping_Function is
access function (From : in Character) return Character;
access function (From : Character) return Character;
private
pragma Inline (Is_In);
......
......@@ -831,13 +831,6 @@ package body Checks is
if Size_Known_At_Compile_Time (Typ) then
return;
end if;
-- No problem on 64-bit machines, we just don't bother with
-- the case where the size in bytes overflows 64-bits.
if System_Address_Size = 64 then
return;
end if;
end if;
-- Following code is temporarily deleted, since GCC 3 is returning
......
......@@ -325,15 +325,14 @@ package body Clean is
procedure Clean_Archive (Project : Project_Id) is
Current_Dir : constant Dir_Name_Str := Get_Current_Dir;
Data : constant Project_Data := Projects.Table (Project);
Archive_Name : constant String :=
"lib" & Get_Name_String (Data.Name) & '.' & Archive_Ext;
"lib" & Get_Name_String (Data.Name) & '.' & Archive_Ext;
-- The name of the archive file for this project
Archive_Dep_Name : constant String :=
"lib" & Get_Name_String (Data.Name) & ".deps";
"lib" & Get_Name_String (Data.Name) & ".deps";
-- The name of the archive dependency file for this project
Obj_Dir : constant String := Get_Name_String (Data.Object_Directory);
......@@ -439,8 +438,7 @@ package body Clean is
Extract_From_Q (Lib_File);
Full_Lib_File := Osint.Full_Lib_File_Name (Lib_File);
-- If we have an existing ALI file that is not read-only,
-- process it.
-- If we have existing ALI file that is not read-only, process it
if Full_Lib_File /= No_File
and then not Is_Readonly_Library (Full_Lib_File)
......@@ -484,8 +482,7 @@ package body Clean is
end if;
end if;
-- Now, delete all the existing files corresponding to this
-- ALI file.
-- Now delete all existing files corresponding to this ALI file
declare
Obj_Dir : constant String :=
......@@ -515,9 +512,10 @@ package body Clean is
for J in 1 .. Sources.Last loop
declare
Deb : constant String :=
Debug_File_Name (Sources.Table (J));
Debug_File_Name (Sources.Table (J));
Rep : constant String :=
Repinfo_File_Name (Sources.Table (J));
Repinfo_File_Name (Sources.Table (J));
begin
if Is_Regular_File (Obj_Dir & Dir_Separator & Deb) then
Delete (Obj_Dir, Deb);
......@@ -557,8 +555,7 @@ package body Clean is
procedure Clean_Project (Project : Project_Id) is
Main_Source_File : File_Name_Type;
-- Name of the executable on the command line, without directory
-- information.
-- Name of executable on the command line without directory info
Executable : Name_Id;
-- Name of the executable file
......@@ -610,7 +607,8 @@ package body Clean is
begin
Change_Dir (Obj_Dir);
-- First, deal with Ada.
-- First, deal with Ada
-- Look through the units to find those that are either immediate
-- sources or inherited sources of the project.
......@@ -765,8 +763,9 @@ package body Clean is
end if;
if Data.Other_Sources_Present then
-- There is non-Ada code: delete the object files and
-- the dependency files, if they exist.
-- the dependency files if they exist.
Source_Id := Data.First_Other_Source;
......@@ -1093,8 +1092,8 @@ package body Clean is
Prj.Pars.Set_Verbosity (To => Prj.Com.Current_Verbosity);
-- Parse the project file.
-- If there is an error, Main_Project will still be No_Project.
-- Parse the project file. If there is an error, Main_Project
-- will still be No_Project.
Prj.Pars.Parse
(Project => Main_Project,
......@@ -1103,8 +1102,7 @@ package body Clean is
Process_Languages => All_Languages);
if Main_Project = No_Project then
Fail ("""" & Project_File_Name.all &
""" processing failed");
Fail ("""" & Project_File_Name.all & """ processing failed");
end if;
if Opt.Verbose_Mode then
......@@ -1311,7 +1309,8 @@ package body Clean is
procedure Parse_Cmd_Line is
Source_Index : Int := 0;
Index : Positive := 1;
Last : constant Natural := Argument_Count;
Last : constant Natural := Argument_Count;
begin
while Index <= Last loop
declare
......
......@@ -826,8 +826,8 @@ package body Exp_Ch5 is
-- the explicit bounds of right- and left-hand side.
declare
Proc : constant Node_Id :=
TSS (Base_Type (L_Type), TSS_Slice_Assign);
Proc : constant Node_Id :=
TSS (Base_Type (L_Type), TSS_Slice_Assign);
Actuals : List_Id;
begin
......@@ -840,7 +840,10 @@ package body Exp_Ch5 is
Duplicate_Subexpr (Left_Hi, Name_Req => True),
Duplicate_Subexpr (Right_Lo, Name_Req => True),
Duplicate_Subexpr (Right_Hi, Name_Req => True));
Append_To (Actuals, Condition);
Append_To (Actuals,
Make_Op_Not (Loc,
Right_Opnd => Condition));
Rewrite (N,
Make_Procedure_Call_Statement (Loc,
......
......@@ -2384,34 +2384,6 @@ package body Exp_Util is
---------------------------------
function Is_Possibly_Unaligned_Slice (P : Node_Id) return Boolean is
function Has_Non_Trivial_Component_Clause (E : Entity_Id) return Boolean;
-- Check whether the component clause might place the component at an
-- alignment that will require the use of a copy when a slice is passed
-- as a parameter. The code is conservative because at this point the
-- expander does not know the alignment choice that the back-end will
-- make. For now we return true if the component is not the first one
-- in the enclosing record. This routine is a place holder for further
-- analysis of this kind.
--------------------------------------
-- Has_Non_Trivial_Component_Clause --
--------------------------------------
function Has_Non_Trivial_Component_Clause (E : Entity_Id) return Boolean
is
Rep_Clause : constant Node_Id := Component_Clause (E);
begin
if No (Rep_Clause) then
return False;
else
return Intval (Position (Rep_Clause)) /= Uint_0
or else Intval (First_Bit (Rep_Clause)) /= Uint_0;
end if;
end Has_Non_Trivial_Component_Clause;
-- Start of processing for Is_Possibly_Unaligned_Slice
begin
-- ??? GCC3 will eventually handle strings with arbitrary alignments,
-- but for now the following check must be disabled.
......@@ -2420,6 +2392,8 @@ package body Exp_Util is
-- return False;
-- end if;
-- For renaming case, go to renamed object
if Is_Entity_Name (P)
and then Is_Object (Entity (P))
and then Present (Renamed_Object (Entity (P)))
......@@ -2427,57 +2401,121 @@ package body Exp_Util is
return Is_Possibly_Unaligned_Slice (Renamed_Object (Entity (P)));
end if;
-- We only need to worry if the target has strict alignment, unless
-- it is a nested record component with a component clause, which
-- Gigi does not handle well. This patch should disappear with GCC 3.0
-- and it is not clear why it is needed even when the representation
-- clause is a confirming one, but in its absence gigi complains that
-- the slice is not addressable.???
-- The reference must be a slice
if not Target_Strict_Alignment then
if Nkind (P) /= N_Slice
or else Nkind (Prefix (P)) /= N_Selected_Component
or else Nkind (Prefix (Prefix (P))) /= N_Selected_Component
then
return False;
end if;
if Nkind (P) /= N_Slice then
return False;
end if;
-- The reference must be a slice
-- Always assume the worst for a nested record component with a
-- component clause, which gigi/gcc does not appear to handle well.
-- It is not clear why this special test is needed at all ???
if Nkind (P) /= N_Slice then
if Nkind (Prefix (P)) = N_Selected_Component
and then Nkind (Prefix (Prefix (P))) = N_Selected_Component
and then
Present (Component_Clause (Entity (Selector_Name (Prefix (P)))))
then
return True;
end if;
-- We only need to worry if the target has strict alignment
if not Target_Strict_Alignment then
return False;
end if;
-- If it is a slice, then look at the array type being sliced
declare
Pref : constant Node_Id := Prefix (P);
Typ : constant Entity_Id := Etype (Prefix (P));
Sarr : constant Node_Id := Prefix (P);
-- Prefix of the slice, i.e. the array being sliced
Styp : constant Entity_Id := Etype (Prefix (P));
-- Type of the array being sliced
Pref : Node_Id;
Ptyp : Entity_Id;
begin
-- The worrisome case is one where we don't know the alignment
-- of the array, or we know it and it is greater than 1 (if the
-- alignment is one, then obviously it cannot be misaligned).
-- The problems arise if the array object that is being sliced
-- is a component of a record or array, and we cannot guarantee
-- the alignment of the array within its containing object.
if Known_Alignment (Typ) and then Alignment (Typ) = 1 then
return False;
end if;
-- To investigate this, we look at successive prefixes to see
-- if we have a worrisome indexed or selected component.
-- The only way we can be unaligned is if the array being sliced
-- is a component of a record, and either the record is packed,
-- or the component has a component clause, or the record has
-- a specified alignment (that might be too small).
Pref := Sarr;
loop
-- Case of array is part of an indexed component reference
return
Nkind (Pref) = N_Selected_Component
and then
(Is_Packed (Etype (Prefix (Pref)))
or else
Known_Alignment (Etype (Prefix (Pref)))
or else
Has_Non_Trivial_Component_Clause
(Entity (Selector_Name (Pref))));
if Nkind (Pref) = N_Indexed_Component then
Ptyp := Etype (Prefix (Pref));
-- The only problematic case is when the array is packed,
-- in which case we really know nothing about the alignment
-- of individual components.
if Is_Bit_Packed_Array (Ptyp) then
return True;
end if;
-- Case of array is part of a selected component reference
elsif Nkind (Pref) = N_Selected_Component then
Ptyp := Etype (Prefix (Pref));
-- We are definitely in trouble if the record in question
-- has an alignment, and either we know this alignment is
-- inconsistent with the alignment of the slice, or we
-- don't know what the alignment of the slice should be.
if Known_Alignment (Ptyp)
and then (Unknown_Alignment (Styp)
or else Alignment (Styp) > Alignment (Ptyp))
then
return True;
end if;
-- We are in potential trouble if the record type is packed.
-- We could special case when we know that the array is the
-- first component, but that's not such a simple case ???
if Is_Packed (Ptyp) then
return True;
end if;
-- We are in trouble if there is a component clause, and
-- either we do not know the alignment of the slice, or
-- the alignment of the slice is inconsistent with the
-- bit position specified by the component clause.
declare
Field : constant Entity_Id := Entity (Selector_Name (Pref));
begin
if Present (Component_Clause (Field))
and then
(Unknown_Alignment (Styp)
or else
(Component_Bit_Offset (Field) mod
(System_Storage_Unit * Alignment (Styp))) /= 0)
then
return True;
end if;
end;
-- For cases other than selected or indexed components we
-- know we are OK, since no issues arise over alignment.
else
return False;
end if;
-- We processed an indexed component or selected component
-- reference that looked safe, so keep checking prefixes.
Pref := Prefix (Pref);
end loop;
end;
end Is_Possibly_Unaligned_Slice;
......
......@@ -54,7 +54,8 @@
-- Compile without -g
-- Run the program, and call Call_Chain
-- Recompile with -g
-- Use addr2line to interpret the absolute call locations
-- Use addr2line to interpret the absolute call locations (note that
-- addr2line expects addresses in hexadecimal format).
-- This capability is currently supported on the following targets:
......
......@@ -13309,6 +13309,7 @@ See the chapter on project files in the GNAT Users guide for examples of use.
* Reserved Words::
* Lexical Elements::
* Declarations::
* Empty declarations::
* Typed string declarations::
* Variables::
* Expressions::
......@@ -13379,9 +13380,21 @@ simple_declarative_item ::=
variable_declaration |
typed_variable_declaration |
attribute_declaration |
case_construction
case_construction |
empty_declaration
@end smallexample
@node Empty declarations
@section Empty declarations
@smallexample
empty_declaration ::=
@b{null} ;
@end smallexample
An empty declaration is allowed anywhere a declaration is allowed.
It has no effect.
@node Typed string declarations
@section Typed string declarations
......@@ -13683,7 +13696,7 @@ case_construction ::=
case_item ::=
@b{when} discrete_choice_list =>
@{case_construction | attribute_declaration@}
@{case_construction | attribute_declaration | empty_declaration@}
discrete_choice_list ::=
string_literal @{| string_literal@} |
......
......@@ -10809,6 +10809,8 @@ project Build is
for ^Default_Switches^Default_Switches^ ("Ada")
use ("^-g^-g^");
for Executable ("proc") use "proc1";
when others =>
null;
end case;
 
end Builder;
......
......@@ -2231,7 +2231,9 @@ package body Make is
The_Data := Projects.Table (Prj);
end loop;
if The_Data.Library and then not The_Data.Flag1 then
if The_Data.Library
and then not The_Data.Need_To_Build_Lib
then
-- Add to the Q all sources of the project that
-- have not been marked
......@@ -2242,7 +2244,7 @@ package body Make is
-- Now mark the project as processed
Projects.Table (Prj).Flag1 := True;
Projects.Table (Prj).Need_To_Build_Lib := True;
end if;
end;
end if;
......@@ -4337,10 +4339,10 @@ package body Make is
if MLib.Tgt.Support_For_Libraries /= MLib.Tgt.None then
for Proj in Projects.First .. Projects.Last loop
if Projects.Table (Proj).Library then
Projects.Table (Proj).Flag1 :=
Projects.Table (Proj).Need_To_Build_Lib :=
not MLib.Tgt.Library_Exists_For (Proj);
if Projects.Table (Proj).Flag1 then
if Projects.Table (Proj).Need_To_Build_Lib then
if Verbose_Mode then
Write_Str
("Library file does not exist for project """);
......@@ -4722,12 +4724,12 @@ package body Make is
end if;
if Projects.Table (Proj1).Library
and then not Projects.Table (Proj1).Flag1
and then not Projects.Table (Proj1).Need_To_Build_Lib
then
MLib.Prj.Check_Library (Proj1);
end if;
if Projects.Table (Proj1).Flag1 then
if Projects.Table (Proj1).Need_To_Build_Lib then
Library_Projs.Increment_Last;
Current := Library_Projs.Last;
Depth := Projects.Table (Proj1).Depth;
......@@ -4744,7 +4746,7 @@ package body Make is
end loop;
Library_Projs.Table (Current) := Proj1;
Projects.Table (Proj1).Flag1 := False;
Projects.Table (Proj1).Need_To_Build_Lib := False;
end if;
end loop;
end;
......
......@@ -2395,16 +2395,10 @@ package body Makegpr is
if not Compile_Only then
-- If there are linking options from the command line,
-- transmit them to gnatmake.
-- Linking options
if Linker_Options.Last /= 0 then
Add_Argument (Dash_largs, True);
for Arg in 1 .. Linker_Options.Last loop
Add_Argument (Linker_Options.Table (Arg), True);
end loop;
else
Add_Argument (Dash_largs, Verbose_Mode);
end if;
......@@ -2412,6 +2406,13 @@ package body Makegpr is
-- Add the archives
Add_Archives (For_Gnatmake => True);
-- If there are linking options from the command line,
-- transmit them to gnatmake.
for Arg in 1 .. Linker_Options.Last loop
Add_Argument (Linker_Options.Table (Arg), True);
end loop;
end if;
-- And invoke gnatmake
......@@ -3318,6 +3319,10 @@ package body Makegpr is
Get_Name_String (Source.Object_Name),
True);
-- Add all the archives, in a correct order
Add_Archives (For_Gnatmake => False);
-- Add the switches specified in package Linker of
-- the main project.
......@@ -3345,10 +3350,6 @@ package body Makegpr is
Add_Argument (Linker_Options.Table (Arg), True);
end loop;
-- Add all the archives, in a correct order
Add_Archives (For_Gnatmake => False);
-- If there are shared libraries and the run path
-- option is supported, add the run path switch.
......
......@@ -1556,7 +1556,7 @@ package body MLib.Prj is
Data : constant Project_Data := Projects.Table (For_Project);
begin
if Data.Library and not Data.Flag1 then
if Data.Library and not Data.Need_To_Build_Lib then
declare
Current : constant Dir_Name_Str := Get_Current_Dir;
Lib_Name : constant Name_Id := Library_File_Name_For (For_Project);
......@@ -1596,17 +1596,17 @@ package body MLib.Prj is
Obj_TS := File_Stamp (Name_Find);
-- If library file time stamp is earlier, set Flag1 and
-- return. String comparaison is used, otherwise time stamps
-- may be too close and the comparaison would return True,
-- which would trigger an unnecessary rebuild of the
-- library.
-- If library file time stamp is earlier, set
-- Need_To_Build_Lib and return. String comparaison is used,
-- otherwise time stamps may be too close and the
-- comparaison would return True, which would trigger
-- an unnecessary rebuild of the library.
if String (Lib_TS) < String (Obj_TS) then
-- Library must be rebuilt
Projects.Table (For_Project).Flag1 := True;
Projects.Table (For_Project).Need_To_Build_Lib := True;
exit;
end if;
end if;
......
......@@ -134,8 +134,8 @@ package body MLib.Tgt is
pragma Unreferenced (Lib_Version);
Lib_File : constant String :=
Lib_Dir & Directory_Separator & "lib" &
MLib.Fil.Ext_To (Lib_Filename, DLL_Ext);
Lib_Dir & Directory_Separator & "lib" &
MLib.Fil.Ext_To (Lib_Filename, DLL_Ext);
-- The file name of the library
Init_Fini : Argument_List_Access := Empty_Argument_List;
......
......@@ -113,8 +113,8 @@ package body MLib.Tgt is
pragma Unreferenced (Symbol_Data);
Lib_File : constant String :=
Lib_Dir & Directory_Separator & "lib" &
MLib.Fil.Ext_To (Lib_Filename, DLL_Ext);
Lib_Dir & Directory_Separator & "lib" &
MLib.Fil.Ext_To (Lib_Filename, DLL_Ext);
Version_Arg : String_Access;
Symbolic_Link_Needed : Boolean := False;
......@@ -135,6 +135,7 @@ package body MLib.Tgt is
end if;
-- If specified, add automatic elaboration/finalization
if Auto_Init then
Init_Fini := Init_Fini_List;
Init_Fini (2) := new String'("-Wl," & Lib_Filename & "init");
......
......@@ -114,8 +114,8 @@ package body MLib.Tgt is
pragma Unreferenced (Symbol_Data);
Lib_File : constant String :=
Lib_Dir & Directory_Separator & "lib" &
MLib.Fil.Ext_To (Lib_Filename, DLL_Ext);
Lib_Dir & Directory_Separator & "lib" &
MLib.Fil.Ext_To (Lib_Filename, DLL_Ext);
Version_Arg : String_Access;
Symbolic_Link_Needed : Boolean := False;
......@@ -129,6 +129,7 @@ package body MLib.Tgt is
end if;
-- If specified, add automatic elaboration/finalization
if Auto_Init then
Init_Fini := Init_Fini_List;
Init_Fini (2) := new String'("-Wl," & Lib_Filename & "init");
......
......@@ -117,8 +117,8 @@ package body MLib.Tgt is
pragma Unreferenced (Symbol_Data);
Lib_File : constant String :=
Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Filename, DLL_Ext);
Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Filename, DLL_Ext);
Version_Arg : String_Access;
Symbolic_Link_Needed : Boolean := False;
......@@ -132,6 +132,7 @@ package body MLib.Tgt is
end if;
-- If specified, add automatic elaboration/finalization
if Auto_Init then
Init_Fini := Init_Fini_List;
Init_Fini (2) := new String'("-Wl," & Lib_Filename & "init");
......
......@@ -107,8 +107,8 @@ package body MLib.Tgt is
pragma Unreferenced (Lib_Version);
Lib_File : constant String :=
Lib_Dir & Directory_Separator &
Files.Ext_To (Lib_Filename, DLL_Ext);
Lib_Dir & Directory_Separator &
Files.Ext_To (Lib_Filename, DLL_Ext);
-- Start of processing for Build_Dynamic_Library
......@@ -207,7 +207,7 @@ package body MLib.Tgt is
else
return Is_Regular_File
(Lib_Dir & Directory_Separator & "lib" &
(Lib_Dir & Directory_Separator &
MLib.Fil.Ext_To (Lib_Name, DLL_Ext));
end if;
end;
......@@ -231,13 +231,13 @@ package body MLib.Tgt is
Get_Name_String (Projects.Table (Project).Library_Name);
begin
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
if Projects.Table (Project).Library_Kind = Static then
Name_Len := 3;
Name_Buffer (1 .. Name_Len) := "lib";
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, Archive_Ext));
else
Name_Len := 0;
Add_Str_To_Name_Buffer (Fil.Ext_To (Lib_Name, DLL_Ext));
end if;
......
......@@ -111,8 +111,8 @@ package body MLib.Tgt is
pragma Unreferenced (Symbol_Data);
Lib_File : constant String :=
Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Filename, DLL_Ext);
Lib_Dir & Directory_Separator & "lib" &
Fil.Ext_To (Lib_Filename, DLL_Ext);
Version_Arg : String_Access;
Symbolic_Link_Needed : Boolean := False;
......@@ -126,6 +126,7 @@ package body MLib.Tgt is
end if;
-- If specified, add automatic elaboration/finalization
if Auto_Init then
Init_Fini := Init_Fini_List;
Init_Fini (1) :=
......
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