mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-24 22:11:56 +08:00
[Ada] Clean up ??? marks
gcc/ada/ * binde.adb: No need for ??? marks in Binde, because it is superseded by Bindo. * bindo-writers.adb (Write_Unit_Closure): Verified that -Ra works. * exp_ch4.adb, sinfo.ads (Expand_N_Type_Conversion): Rules for conversions passed to gigi are documented in sinfo.ads. (Expand_N_Unchecked_Type_Conversion): Comment is a duplicate of one in sinfo.ads. (Expand_N_In): Robert already added sufficient comments years after the ??? comment was inserted. (Expand_Membership_Minimize_Eliminate_Overflow): I don't see any reason why Stand should export Long_Long_Integer'Base -- it doesn't export any other base types. (Size_In_Storage_Elements): We are doing an allocator, so we don't care about sizes in bits. (Expand_N_Allocator): PolyORB isn't going to be significantly improved, so we're not going to mess with remote access to class-wide types. (Optimize_Return_Stmt): It's not important to optimize return statements in predicate functions -- there are many more-important optimizations we could do. Keep part of the comment without "???", to clarify why the "and then ...". (User_Defined_Primitive_Equality_Op): The optimization doesn't seem important enough. (Expand_N_Unchecked_Type_Conversion): Refactor to use Expand_N_Unchecked_Expression. (Make_Array_Comparison_Op): This seems like a case of "it it's not broken, don't fix it". Too much risk of causing bugs. * debug_a.adb: Remove ??? comments asking why Current_Error_Node is maintained unconditionally, and add a comment explaining why. * errout.adb: These kinds of minor bugs do indeed exist, but we're never going to get around to fixing them "properly", so we need this code for robustness. * gnatchop.adb (Read_File): Document when read can fail. * gnatdll.adb (Parse_Command_Line): Nobody is complaining about these arbitrary limits, so no need to use Table. Increase the limits just in case. It is clear from the names what they are limits on. * gnatlink.adb: Add needed comments. (Delete): An existing comment makes clear it's intentional, and it's been like that since 1996. (Process_Args): Improve comments. (Search_Library_Path): Refactoring to avoid deep nesting. * inline.adb (Build_Body_To_Inline): Probably won't get around to doing that optimization. (Is_Unit_Subprogram): No, this should not be moved to Sem_Aux, because it is too specialized to this context. (Do_Reset): No comment is needed here; it's clear from the comment on Reset_Dispatching_Calls. Do_Reset is an artificial subprogram; if we had proper iterators, it would just be an if statement in the loop. (Rewrite_Function_Call): Probably won't get around to doing that optimization. * layout.adb (Layout_Type): The gigi comment doesn't need to be a ??? comment, and it's been that way since 2000. The limitation to scalars will likely never be investigated, and it's been that way since 2009. * lib.adb (Check_Same_Extended_Unit): This doesn't look like something that needs fixing; it looks like a permanent workaround. * lib-load.adb (Change_Main_Unit_To_Spec): It is good enough in practice. (Load_Unit): Nobody will ever get around to investigating the obscure PMES oddity, and the optimization is not worth the trouble. * live.adb: It's not worth documenting this. It is used only with a debug switch. Nobody who has done significant work on it is still around, so it would require substantial investigation. * mdll.ads: I see no reason for USE. * namet.ads: Routines are obsolete, but they're not going anywhere anytime soon (too much work, and surprisingly delicate because of dependences on global variables). * osint.ads: Minor. * osint.adb: Improve comments. (Full_Lib_File_Name): Use Smart_Find_File.
This commit is contained in:
Bob Duff
Pierre-Marie de Rodat
parent
86a9605014
commit
0964be0713
@ -2327,7 +2327,7 @@ package body Binde is
|
||||
-- subsumed by their parent units, but we need to list them for other
|
||||
-- tools. For now they are listed after other files, rather than right
|
||||
-- after their parent, since there is no easy link between the
|
||||
-- elaboration table and the ALIs table ??? As subunits may appear
|
||||
-- elaboration table and the ALIs table. As subunits may appear
|
||||
-- repeatedly in the list, if the parent unit appears in the context of
|
||||
-- several units in the closure, duplicates are suppressed.
|
||||
|
||||
@ -2811,7 +2811,7 @@ package body Binde is
|
||||
or else Withs.Table (W).Elab_All_Desirable
|
||||
then
|
||||
if SCC (U) = SCC (Withed_Unit) then
|
||||
Elab_Cycle_Found := True; -- ???
|
||||
Elab_Cycle_Found := True;
|
||||
|
||||
-- We could probably give better error messages
|
||||
-- than Elab_Old here, but for now, to avoid
|
||||
@ -2873,10 +2873,10 @@ package body Binde is
|
||||
end if;
|
||||
|
||||
-- If there are no nodes with predecessors, then either we are
|
||||
-- done, as indicated by Num_Left being set to zero, or we have
|
||||
-- a circularity. In the latter case, diagnose the circularity,
|
||||
-- removing it from the graph and continue.
|
||||
-- ????But Diagnose_Elaboration_Problem always raises an
|
||||
-- done, as indicated by Num_Left being set to zero, or we have a
|
||||
-- circularity. In the latter case, diagnose the circularity,
|
||||
-- removing it from the graph and
|
||||
-- continue. Diagnose_Elaboration_Problem always raises an
|
||||
-- exception, so the loop never goes around more than once.
|
||||
|
||||
Get_No_Pred : while No_Pred = No_Unit_Id loop
|
||||
@ -3086,11 +3086,11 @@ package body Binde is
|
||||
Outer : loop
|
||||
|
||||
-- If there are no nodes with predecessors, then either we are
|
||||
-- done, as indicated by Num_Left being set to zero, or we have
|
||||
-- a circularity. In the latter case, diagnose the circularity,
|
||||
-- done, as indicated by Num_Left being set to zero, or we have a
|
||||
-- circularity. In the latter case, diagnose the circularity,
|
||||
-- removing it from the graph and continue.
|
||||
-- ????But Diagnose_Elaboration_Problem always raises an
|
||||
-- exception, so the loop never goes around more than once.
|
||||
-- Diagnose_Elaboration_Problem always raises an exception, so the
|
||||
-- loop never goes around more than once.
|
||||
|
||||
Get_No_Pred : while No_Pred = No_Unit_Id loop
|
||||
exit Outer when Num_Left < 1;
|
||||
|
||||
@ -1689,8 +1689,8 @@ package body Bindo.Writers is
|
||||
if Contains (Set, Source) then
|
||||
return;
|
||||
|
||||
-- Nothing to do for internal source files unless switch -Ra (???) is
|
||||
-- in effect.
|
||||
-- Nothing to do for internal source files unless switch -Ra is in
|
||||
-- effect.
|
||||
|
||||
elsif Is_Internal_File_Name (Source)
|
||||
and then not List_Closure_All
|
||||
|
||||
@ -46,6 +46,12 @@ package body Debug_A is
|
||||
-- recursion levels, we just don't reset the right value on exit, which
|
||||
-- is not crucial, since this is only for debugging.
|
||||
|
||||
-- Note that Current_Error_Node must be maintained unconditionally (not
|
||||
-- only when Debug_Flag_A is True), because we want to print a correct sloc
|
||||
-- in bug boxes. Also, Current_Error_Node is not just used for printing bug
|
||||
-- boxes. For example, an incorrect Current_Error_Node can cause some code
|
||||
-- in Rtsfind to malfunction.
|
||||
|
||||
-----------------------
|
||||
-- Local Subprograms --
|
||||
-----------------------
|
||||
@ -75,8 +81,6 @@ package body Debug_A is
|
||||
|
||||
-- Now push the new element
|
||||
|
||||
-- Why is this done unconditionally???
|
||||
|
||||
Debug_A_Depth := Debug_A_Depth + 1;
|
||||
|
||||
if Debug_A_Depth <= Max_Node_Ids then
|
||||
@ -103,8 +107,6 @@ package body Debug_A is
|
||||
-- We look down the stack to find something with a decent Sloc. (If
|
||||
-- we find nothing, just leave it unchanged which is not so terrible)
|
||||
|
||||
-- This seems nasty overhead for the normal case ???
|
||||
|
||||
for J in reverse 1 .. Integer'Min (Max_Node_Ids, Debug_A_Depth) loop
|
||||
if Sloc (Node_Ids (J)) > No_Location then
|
||||
Current_Error_Node := Node_Ids (J);
|
||||
|
||||
@ -1825,10 +1825,6 @@ package body Errout is
|
||||
F := First_Node (N);
|
||||
S := Sloc (F);
|
||||
|
||||
-- ??? Protect against inconsistency in locations, by returning S
|
||||
-- immediately if not in the expected range, rather than failing with
|
||||
-- a Constraint_Error when accessing Source_Text(SI)(S)
|
||||
|
||||
if S not in SF .. SL then
|
||||
return S;
|
||||
end if;
|
||||
@ -1944,10 +1940,6 @@ package body Errout is
|
||||
F := Last_Node (N);
|
||||
S := Sloc (F);
|
||||
|
||||
-- ??? Protect against inconsistency in locations, by returning S
|
||||
-- immediately if not in the expected range, rather than failing with
|
||||
-- a Constraint_Error when accessing Source_Text(SI)(S)
|
||||
|
||||
if S not in SF .. SL then
|
||||
return S;
|
||||
end if;
|
||||
|
||||
@ -3030,10 +3030,8 @@ package body Exp_Ch4 is
|
||||
-- check when creating the upper bound. This is needed to avoid junk
|
||||
-- overflow checks in the common case of String types.
|
||||
|
||||
-- ??? Disabled for now
|
||||
|
||||
-- elsif Istyp = Standard_Positive then
|
||||
-- Artyp := Standard_Unsigned;
|
||||
elsif Istyp = Standard_Positive then
|
||||
Artyp := Standard_Unsigned;
|
||||
|
||||
-- For modular types, we use a 32-bit modular type for types whose size
|
||||
-- is in the range 1-31 bits. For 32-bit unsigned types, we use the
|
||||
@ -3793,7 +3791,7 @@ package body Exp_Ch4 is
|
||||
-- Bounds in Minimize calls, not used currently
|
||||
|
||||
LLIB : constant Entity_Id := Base_Type (Standard_Long_Long_Integer);
|
||||
-- Entity for Long_Long_Integer'Base (Standard should export this???)
|
||||
-- Entity for Long_Long_Integer'Base
|
||||
|
||||
begin
|
||||
Minimize_Eliminate_Overflows (Lop, Lo, Hi, Top_Level => False);
|
||||
@ -4489,10 +4487,6 @@ package body Exp_Ch4 is
|
||||
-- are too large, and which in the absence of a check results in
|
||||
-- undetected chaos ???
|
||||
|
||||
-- Note in particular that this is a pessimistic estimate in the
|
||||
-- case of packed array types, where an array element might occupy
|
||||
-- just a fraction of a storage element???
|
||||
|
||||
declare
|
||||
Idx : Node_Id := First_Index (E);
|
||||
Len : Node_Id;
|
||||
@ -4614,9 +4608,10 @@ package body Exp_Ch4 is
|
||||
end if;
|
||||
|
||||
-- RM E.2.2(17). We enforce that the expected type of an allocator
|
||||
-- shall not be a remote access-to-class-wide-limited-private type
|
||||
|
||||
-- Why is this being done at expansion time, seems clearly wrong ???
|
||||
-- shall not be a remote access-to-class-wide-limited-private type.
|
||||
-- We probably shouldn't be doing this legality check during expansion,
|
||||
-- but this is only an issue for Annex E users, and is unlikely to be a
|
||||
-- problem in practice.
|
||||
|
||||
Validate_Remote_Access_To_Class_Wide_Type (N);
|
||||
|
||||
@ -5558,10 +5553,8 @@ package body Exp_Ch4 is
|
||||
if Is_Copy_Type (Typ) then
|
||||
Target_Typ := Typ;
|
||||
|
||||
-- ??? Do not perform the optimization when the return statement is
|
||||
-- within a predicate function, as this causes spurious errors. Could
|
||||
-- this be a possible mismatch in handling this case somewhere else
|
||||
-- in semantic analysis?
|
||||
-- Do not perform the optimization when the return statement is
|
||||
-- within a predicate function, as this causes spurious errors.
|
||||
|
||||
Optimize_Return_Stmt :=
|
||||
Nkind (Par) = N_Simple_Return_Statement and then not In_Predicate;
|
||||
@ -6345,13 +6338,11 @@ package body Exp_Ch4 is
|
||||
-- perspective.
|
||||
|
||||
if Comes_From_Source (Obj_Ref) then
|
||||
|
||||
-- Recover the actual object reference. There may be more cases
|
||||
-- to consider???
|
||||
|
||||
loop
|
||||
if Nkind (Obj_Ref) in
|
||||
N_Type_Conversion | N_Unchecked_Type_Conversion
|
||||
N_Type_Conversion |
|
||||
N_Unchecked_Type_Conversion |
|
||||
N_Qualified_Expression
|
||||
then
|
||||
Obj_Ref := Expression (Obj_Ref);
|
||||
else
|
||||
@ -6496,8 +6487,6 @@ package body Exp_Ch4 is
|
||||
begin
|
||||
-- If test is explicit x'First .. x'Last, replace by valid check
|
||||
|
||||
-- Could use some individual comments for this complex test ???
|
||||
|
||||
if Is_Scalar_Type (Ltyp)
|
||||
|
||||
-- And left operand is X'First where X matches left operand
|
||||
@ -8105,10 +8094,6 @@ package body Exp_Ch4 is
|
||||
Enclosing_Scope : constant Node_Id := Scope (Typ);
|
||||
E : Entity_Id;
|
||||
begin
|
||||
-- Prune this search by somehow not looking at decls that precede
|
||||
-- the declaration of the first view of Typ (which might be a partial
|
||||
-- view)???
|
||||
|
||||
for Private_Entities in Boolean loop
|
||||
if Private_Entities then
|
||||
if Ekind (Enclosing_Scope) /= E_Package then
|
||||
@ -12702,17 +12687,7 @@ package body Exp_Ch4 is
|
||||
|
||||
-- At this stage, either the conversion node has been transformed into
|
||||
-- some other equivalent expression, or left as a conversion that can be
|
||||
-- handled by Gigi, in the following cases:
|
||||
|
||||
-- Conversions with no change of representation or type
|
||||
|
||||
-- Numeric conversions involving integer, floating- and fixed-point
|
||||
-- values. Fixed-point values are allowed only if Conversion_OK is
|
||||
-- set, i.e. if the fixed-point values are to be treated as integers.
|
||||
|
||||
-- No other conversions should be passed to Gigi
|
||||
|
||||
-- Check: are these rules stated in sinfo??? if so, why restate here???
|
||||
-- handled by Gigi.
|
||||
|
||||
-- The only remaining step is to generate a range check if we still have
|
||||
-- a type conversion at this stage and Do_Range_Check is set. Note that
|
||||
@ -12831,14 +12806,7 @@ package body Exp_Ch4 is
|
||||
-- an Assignment_OK indication which must be propagated to the operand.
|
||||
|
||||
if Operand_Type = Target_Type then
|
||||
|
||||
-- Code duplicates Expand_N_Unchecked_Expression above, factor???
|
||||
|
||||
if Assignment_OK (N) then
|
||||
Set_Assignment_OK (Operand);
|
||||
end if;
|
||||
|
||||
Rewrite (N, Relocate_Node (Operand));
|
||||
Expand_N_Unchecked_Expression (N);
|
||||
return;
|
||||
end if;
|
||||
|
||||
@ -12869,9 +12837,6 @@ package body Exp_Ch4 is
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- Otherwise force evaluation unless Assignment_OK flag is set (this
|
||||
-- flag indicates ??? More comments needed here)
|
||||
|
||||
if Assignment_OK (N) then
|
||||
null;
|
||||
else
|
||||
@ -13805,9 +13770,6 @@ package body Exp_Ch4 is
|
||||
-- do not need to generate an actual or formal generic part, just the
|
||||
-- instantiated function itself.
|
||||
|
||||
-- Perhaps we could have the actual generic available in the run-time,
|
||||
-- obtained by rtsfind, and actually expand a real instantiation ???
|
||||
|
||||
function Make_Array_Comparison_Op
|
||||
(Typ : Entity_Id;
|
||||
Nod : Node_Id) return Node_Id
|
||||
|
||||
@ -995,9 +995,8 @@ procedure Gnatchop is
|
||||
|
||||
Buffer (Read_Ptr) := EOF;
|
||||
|
||||
-- Comment needed for the following ???
|
||||
-- Under what circumstances can the test fail ???
|
||||
-- What is copy doing in that case???
|
||||
-- The following test can fail if there was an I/O error, in which case
|
||||
-- Success will be set to False.
|
||||
|
||||
if Read_Ptr = Length then
|
||||
Contents := Buffer;
|
||||
|
||||
@ -172,11 +172,8 @@ procedure Gnatdll is
|
||||
-- Add the files listed in List_Filename (one by line) to the list
|
||||
-- of file to handle
|
||||
|
||||
Max_Files : constant := 5_000;
|
||||
Max_Options : constant := 100;
|
||||
-- These are arbitrary limits, a better way will be to use linked list.
|
||||
-- No, a better choice would be to use tables ???
|
||||
-- Limits on what???
|
||||
Max_Files : constant := 50_000;
|
||||
Max_Options : constant := 1_000;
|
||||
|
||||
Ofiles : Argument_List (1 .. Max_Files);
|
||||
O : Positive := Ofiles'First;
|
||||
|
||||
@ -69,7 +69,7 @@ procedure Gnatlink is
|
||||
Table_Initial => 20,
|
||||
Table_Increment => 100,
|
||||
Table_Name => "Gnatlink.Gcc_Linker_Options");
|
||||
-- Comments needed ???
|
||||
-- Options to be passed to the gcc linker
|
||||
|
||||
package Libpath is new Table.Table (
|
||||
Table_Component_Type => Character,
|
||||
@ -78,7 +78,7 @@ procedure Gnatlink is
|
||||
Table_Initial => 4096,
|
||||
Table_Increment => 100,
|
||||
Table_Name => "Gnatlink.Libpath");
|
||||
-- Comments needed ???
|
||||
-- Library search path
|
||||
|
||||
package Linker_Options is new Table.Table (
|
||||
Table_Component_Type => String_Access,
|
||||
@ -87,7 +87,7 @@ procedure Gnatlink is
|
||||
Table_Initial => 20,
|
||||
Table_Increment => 100,
|
||||
Table_Name => "Gnatlink.Linker_Options");
|
||||
-- Comments needed ???
|
||||
-- Options to be passed to gnatlink
|
||||
|
||||
package Linker_Objects is new Table.Table (
|
||||
Table_Component_Type => String_Access,
|
||||
@ -204,12 +204,45 @@ procedure Gnatlink is
|
||||
-- Indicates wether libgcc should be statically linked (use 'T') or
|
||||
-- dynamically linked (use 'H') by default.
|
||||
|
||||
Link_Max : Integer;
|
||||
pragma Import (C, Link_Max, "__gnat_link_max");
|
||||
-- Maximum number of bytes on the command line supported by the OS
|
||||
-- linker. Passed this limit the response file mechanism must be used
|
||||
-- if supported.
|
||||
|
||||
Run_Path_Option_Ptr : Interfaces.C.Strings.chars_ptr;
|
||||
pragma Import (C, Run_Path_Option_Ptr, "__gnat_run_path_option");
|
||||
-- Pointer to string representing the native linker option which
|
||||
-- specifies the path where the dynamic loader should find shared
|
||||
-- libraries. Equal to null string if this system doesn't support it.
|
||||
|
||||
Libgcc_Subdir_Ptr : Interfaces.C.Strings.chars_ptr;
|
||||
pragma Import (C, Libgcc_Subdir_Ptr, "__gnat_default_libgcc_subdir");
|
||||
-- Pointer to string indicating the installation subdirectory where
|
||||
-- a default shared libgcc might be found.
|
||||
|
||||
Object_Library_Ext_Ptr : Interfaces.C.Strings.chars_ptr;
|
||||
pragma Import
|
||||
(C, Object_Library_Ext_Ptr, "__gnat_object_library_extension");
|
||||
-- Pointer to string specifying the default extension for
|
||||
-- object libraries, e.g. Unix uses ".a".
|
||||
|
||||
Separate_Run_Path_Options : Boolean;
|
||||
for Separate_Run_Path_Options'Size use Character'Size;
|
||||
pragma Import
|
||||
(C, Separate_Run_Path_Options, "__gnat_separate_run_path_options");
|
||||
-- Whether separate rpath options should be emitted for each directory
|
||||
|
||||
function Get_Maximum_File_Name_Length return Integer;
|
||||
pragma Import (C, Get_Maximum_File_Name_Length,
|
||||
"__gnat_get_maximum_file_name_length");
|
||||
|
||||
function Base_Name (File_Name : String) return String;
|
||||
-- Return just the file name part without the extension (if present)
|
||||
|
||||
procedure Check_Existing_Executable (File_Name : String);
|
||||
-- Delete any existing executable to avoid accidentally updating the target
|
||||
-- of a symbolic link, but produce a Fatail_Error if File_Name matches any
|
||||
-- of a symbolic link, but produce a Fatal_Error if File_Name matches any
|
||||
-- of the source file names. This avoids overwriting of extensionless
|
||||
-- source files by accident on systems where executables do not have
|
||||
-- extensions.
|
||||
@ -229,6 +262,19 @@ procedure Gnatlink is
|
||||
procedure Process_Binder_File (Name : String);
|
||||
-- Reads the binder file and extracts linker arguments
|
||||
|
||||
function Index (S, Pattern : String) return Natural;
|
||||
-- Return the last occurrence of Pattern in S, or 0 if none
|
||||
|
||||
procedure Search_Library_Path
|
||||
(Next_Line : String;
|
||||
Nfirst : Integer;
|
||||
Nlast : Integer;
|
||||
Last : Integer;
|
||||
GNAT_Static : Boolean;
|
||||
GNAT_Shared : Boolean);
|
||||
-- Given a Gnat standard library, search the library path to find the
|
||||
-- library location. Parameters are documented in Process_Binder_File.
|
||||
|
||||
procedure Usage;
|
||||
-- Display usage
|
||||
|
||||
@ -307,7 +353,6 @@ procedure Gnatlink is
|
||||
pragma Unreferenced (Status);
|
||||
begin
|
||||
Status := unlink (Name'Address);
|
||||
-- Is it really right to ignore an error here ???
|
||||
end Delete;
|
||||
|
||||
---------------
|
||||
@ -332,6 +377,23 @@ procedure Gnatlink is
|
||||
Exit_Program (E_Fatal);
|
||||
end Exit_With_Error;
|
||||
|
||||
-----------
|
||||
-- Index --
|
||||
-----------
|
||||
|
||||
function Index (S, Pattern : String) return Natural is
|
||||
Len : constant Natural := Pattern'Length;
|
||||
|
||||
begin
|
||||
for J in reverse S'First .. S'Last - Len + 1 loop
|
||||
if Pattern = S (J .. J + Len - 1) then
|
||||
return J;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
return 0;
|
||||
end Index;
|
||||
|
||||
------------------
|
||||
-- Process_Args --
|
||||
------------------
|
||||
@ -362,21 +424,19 @@ procedure Gnatlink is
|
||||
Arg : constant String := Argument (Next_Arg);
|
||||
|
||||
begin
|
||||
-- Case of argument which is a switch
|
||||
|
||||
-- We definitely need section by section comments here ???
|
||||
-- This argument must not be parsed, just add it to the list of
|
||||
-- linker's options.
|
||||
|
||||
if Skip_Next then
|
||||
|
||||
-- This argument must not be parsed, just add it to the
|
||||
-- list of linker's options.
|
||||
|
||||
Skip_Next := False;
|
||||
|
||||
Linker_Options.Increment_Last;
|
||||
Linker_Options.Table (Linker_Options.Last) :=
|
||||
new String'(Arg);
|
||||
|
||||
-- Case of argument which is a switch
|
||||
|
||||
elsif Arg'Length /= 0 and then Arg (1) = '-' then
|
||||
if Arg'Length > 4 and then Arg (2 .. 5) = "gnat" then
|
||||
Exit_With_Error
|
||||
@ -689,12 +749,6 @@ procedure Gnatlink is
|
||||
Link_Bytes : Integer := 0;
|
||||
-- Projected number of bytes for the linker command line
|
||||
|
||||
Link_Max : Integer;
|
||||
pragma Import (C, Link_Max, "__gnat_link_max");
|
||||
-- Maximum number of bytes on the command line supported by the OS
|
||||
-- linker. Passed this limit the response file mechanism must be used
|
||||
-- if supported.
|
||||
|
||||
Next_Line : String (1 .. 1000);
|
||||
-- Current line value
|
||||
|
||||
@ -752,36 +806,10 @@ procedure Gnatlink is
|
||||
RB_Nlast : Integer; -- Slice last index
|
||||
RB_Nfirst : Integer; -- Slice first index
|
||||
|
||||
Run_Path_Option_Ptr : Interfaces.C.Strings.chars_ptr;
|
||||
pragma Import (C, Run_Path_Option_Ptr, "__gnat_run_path_option");
|
||||
-- Pointer to string representing the native linker option which
|
||||
-- specifies the path where the dynamic loader should find shared
|
||||
-- libraries. Equal to null string if this system doesn't support it.
|
||||
|
||||
Libgcc_Subdir_Ptr : Interfaces.C.Strings.chars_ptr;
|
||||
pragma Import (C, Libgcc_Subdir_Ptr, "__gnat_default_libgcc_subdir");
|
||||
-- Pointer to string indicating the installation subdirectory where
|
||||
-- a default shared libgcc might be found.
|
||||
|
||||
Object_Library_Ext_Ptr : Interfaces.C.Strings.chars_ptr;
|
||||
pragma Import
|
||||
(C, Object_Library_Ext_Ptr, "__gnat_object_library_extension");
|
||||
-- Pointer to string specifying the default extension for
|
||||
-- object libraries, e.g. Unix uses ".a".
|
||||
|
||||
Separate_Run_Path_Options : Boolean;
|
||||
for Separate_Run_Path_Options'Size use Character'Size;
|
||||
pragma Import
|
||||
(C, Separate_Run_Path_Options, "__gnat_separate_run_path_options");
|
||||
-- Whether separate rpath options should be emitted for each directory
|
||||
|
||||
procedure Get_Next_Line;
|
||||
-- Read the next line from the binder file without the line
|
||||
-- terminator.
|
||||
|
||||
function Index (S, Pattern : String) return Natural;
|
||||
-- Return the last occurrence of Pattern in S, or 0 if none
|
||||
|
||||
procedure Store_File_Context;
|
||||
-- Store current file context, Fd position and current line data.
|
||||
-- The file context is stored into the rollback data above (RB_*).
|
||||
@ -823,23 +851,6 @@ procedure Gnatlink is
|
||||
Nlast := Nlast - 1;
|
||||
end Get_Next_Line;
|
||||
|
||||
-----------
|
||||
-- Index --
|
||||
-----------
|
||||
|
||||
function Index (S, Pattern : String) return Natural is
|
||||
Len : constant Natural := Pattern'Length;
|
||||
|
||||
begin
|
||||
for J in reverse S'First .. S'Last - Len + 1 loop
|
||||
if Pattern = S (J .. J + Len - 1) then
|
||||
return J;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
return 0;
|
||||
end Index;
|
||||
|
||||
---------------------------
|
||||
-- Rollback_File_Context --
|
||||
---------------------------
|
||||
@ -1003,7 +1014,7 @@ procedure Gnatlink is
|
||||
Create_Temp_File (Tname_FD, Tname);
|
||||
|
||||
-- ??? File descriptor should be checked to not be Invalid_FD.
|
||||
-- ??? Status of Write and Close operations should be checked, and
|
||||
-- Status of Write and Close operations should be checked, and
|
||||
-- failure should occur if a status is wrong.
|
||||
|
||||
for J in Objs_Begin .. Objs_End loop
|
||||
@ -1115,242 +1126,14 @@ procedure Gnatlink is
|
||||
Last := Nlast;
|
||||
end if;
|
||||
|
||||
-- Given a Gnat standard library, search the library path to
|
||||
-- find the library location.
|
||||
Search_Library_Path
|
||||
(Next_Line => Next_Line,
|
||||
Nfirst => Nfirst,
|
||||
Nlast => Nlast,
|
||||
Last => Last,
|
||||
GNAT_Static => GNAT_Static,
|
||||
GNAT_Shared => GNAT_Shared);
|
||||
|
||||
-- Shouldn't we abstract a proc here, we are getting awfully
|
||||
-- heavily nested ???
|
||||
|
||||
declare
|
||||
File_Path : String_Access;
|
||||
|
||||
Object_Lib_Extension : constant String :=
|
||||
Value (Object_Library_Ext_Ptr);
|
||||
|
||||
File_Name : constant String := "lib" &
|
||||
Next_Line (Nfirst + 2 .. Last) & Object_Lib_Extension;
|
||||
|
||||
Run_Path_Opt : constant String :=
|
||||
Value (Run_Path_Option_Ptr);
|
||||
|
||||
GCC_Index : Natural;
|
||||
Run_Path_Opt_Index : Natural := 0;
|
||||
|
||||
begin
|
||||
File_Path :=
|
||||
Locate_Regular_File (File_Name,
|
||||
String (Libpath.Table (1 .. Libpath.Last)));
|
||||
|
||||
if File_Path /= null then
|
||||
if GNAT_Static then
|
||||
|
||||
-- If static gnatlib found, explicitly specify to
|
||||
-- overcome possible linker default usage of shared
|
||||
-- version.
|
||||
|
||||
Linker_Options.Increment_Last;
|
||||
|
||||
Linker_Options.Table (Linker_Options.Last) :=
|
||||
new String'(File_Path.all);
|
||||
|
||||
elsif GNAT_Shared then
|
||||
if Opt.Run_Path_Option then
|
||||
|
||||
-- If shared gnatlib desired, add appropriate
|
||||
-- system specific switch so that it can be
|
||||
-- located at runtime.
|
||||
|
||||
if Run_Path_Opt'Length /= 0 then
|
||||
|
||||
-- Output the system specific linker command
|
||||
-- that allows the image activator to find
|
||||
-- the shared library at runtime. Also add
|
||||
-- path to find libgcc_s.so, if relevant.
|
||||
|
||||
declare
|
||||
Path : String (1 .. File_Path'Length + 15);
|
||||
|
||||
Path_Last : constant Natural :=
|
||||
File_Path'Length;
|
||||
|
||||
begin
|
||||
Path (1 .. File_Path'Length) :=
|
||||
File_Path.all;
|
||||
|
||||
-- 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
|
||||
-- recent versions of GCC. So, we look for
|
||||
-- the last subdirectory "lib" in the path.
|
||||
|
||||
GCC_Index :=
|
||||
Index (Path (1 .. Path_Last), "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
|
||||
(Path (1 .. Path_Last),
|
||||
"/lib/");
|
||||
|
||||
if GCC_Index = 0 then
|
||||
GCC_Index :=
|
||||
Index (Path (1 .. Path_Last),
|
||||
Directory_Separator & "lib"
|
||||
& Directory_Separator);
|
||||
end if;
|
||||
|
||||
-- If we have found a "lib" subdir in
|
||||
-- the path to libgnat, the possible
|
||||
-- shared libgcc of interest by default
|
||||
-- is in libgcc_subdir at the same
|
||||
-- level.
|
||||
|
||||
if GCC_Index /= 0 then
|
||||
declare
|
||||
Subdir : constant String :=
|
||||
Value (Libgcc_Subdir_Ptr);
|
||||
begin
|
||||
Path
|
||||
(GCC_Index + 1 ..
|
||||
GCC_Index + Subdir'Length) :=
|
||||
Subdir;
|
||||
GCC_Index :=
|
||||
GCC_Index + Subdir'Length;
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Look for an eventual run_path_option in
|
||||
-- the linker switches.
|
||||
|
||||
if Separate_Run_Path_Options then
|
||||
Linker_Options.Increment_Last;
|
||||
Linker_Options.Table
|
||||
(Linker_Options.Last) :=
|
||||
new String'
|
||||
(Run_Path_Opt
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length));
|
||||
|
||||
if GCC_Index /= 0 then
|
||||
Linker_Options.Increment_Last;
|
||||
Linker_Options.Table
|
||||
(Linker_Options.Last) :=
|
||||
new String'
|
||||
(Run_Path_Opt
|
||||
& Path (1 .. GCC_Index));
|
||||
end if;
|
||||
|
||||
else
|
||||
for J in reverse
|
||||
1 .. Linker_Options.Last
|
||||
loop
|
||||
if Linker_Options.Table (J) /= null
|
||||
and then
|
||||
Linker_Options.Table (J)'Length
|
||||
> Run_Path_Opt'Length
|
||||
and then
|
||||
Linker_Options.Table (J)
|
||||
(1 .. Run_Path_Opt'Length) =
|
||||
Run_Path_Opt
|
||||
then
|
||||
-- We have found an already
|
||||
-- specified run_path_option:
|
||||
-- we will add to this
|
||||
-- switch, because only one
|
||||
-- run_path_option should be
|
||||
-- specified.
|
||||
|
||||
Run_Path_Opt_Index := J;
|
||||
exit;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
-- If there is no run_path_option, we
|
||||
-- need to add one.
|
||||
|
||||
if Run_Path_Opt_Index = 0 then
|
||||
Linker_Options.Increment_Last;
|
||||
end if;
|
||||
|
||||
if GCC_Index = 0 then
|
||||
if Run_Path_Opt_Index = 0 then
|
||||
Linker_Options.Table
|
||||
(Linker_Options.Last) :=
|
||||
new String'
|
||||
(Run_Path_Opt
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length));
|
||||
|
||||
else
|
||||
Linker_Options.Table
|
||||
(Run_Path_Opt_Index) :=
|
||||
new String'
|
||||
(Linker_Options.Table
|
||||
(Run_Path_Opt_Index).all
|
||||
& Path_Separator
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length));
|
||||
end if;
|
||||
|
||||
else
|
||||
if Run_Path_Opt_Index = 0 then
|
||||
Linker_Options.Table
|
||||
(Linker_Options.Last) :=
|
||||
new String'
|
||||
(Run_Path_Opt
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length)
|
||||
& Path_Separator
|
||||
& Path (1 .. GCC_Index));
|
||||
|
||||
else
|
||||
Linker_Options.Table
|
||||
(Run_Path_Opt_Index) :=
|
||||
new String'
|
||||
(Linker_Options.Table
|
||||
(Run_Path_Opt_Index).all
|
||||
& Path_Separator
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length)
|
||||
& Path_Separator
|
||||
& Path (1 .. GCC_Index));
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Then we add the appropriate -l switch
|
||||
|
||||
Linker_Options.Increment_Last;
|
||||
Linker_Options.Table (Linker_Options.Last) :=
|
||||
new String'(Next_Line (Nfirst .. Nlast));
|
||||
end if;
|
||||
|
||||
else
|
||||
-- If gnatlib library not found, then add it anyway in
|
||||
-- case some other mechanism may find it.
|
||||
|
||||
Linker_Options.Increment_Last;
|
||||
Linker_Options.Table (Linker_Options.Last) :=
|
||||
new String'(Next_Line (Nfirst .. Nlast));
|
||||
end if;
|
||||
end;
|
||||
else
|
||||
Linker_Options.Increment_Last;
|
||||
Linker_Options.Table (Linker_Options.Last) :=
|
||||
@ -1378,6 +1161,228 @@ procedure Gnatlink is
|
||||
Status := fclose (Fd);
|
||||
end Process_Binder_File;
|
||||
|
||||
-------------------------
|
||||
-- Search_Library_Path --
|
||||
-------------------------
|
||||
|
||||
procedure Search_Library_Path
|
||||
(Next_Line : String;
|
||||
Nfirst : Integer;
|
||||
Nlast : Integer;
|
||||
Last : Integer;
|
||||
GNAT_Static : Boolean;
|
||||
GNAT_Shared : Boolean)
|
||||
is
|
||||
File_Path : String_Access;
|
||||
|
||||
Object_Lib_Extension : constant String :=
|
||||
Value (Object_Library_Ext_Ptr);
|
||||
|
||||
File_Name : constant String := "lib" &
|
||||
Next_Line (Nfirst + 2 .. Last) & Object_Lib_Extension;
|
||||
|
||||
Run_Path_Opt : constant String :=
|
||||
Value (Run_Path_Option_Ptr);
|
||||
|
||||
GCC_Index : Natural;
|
||||
Run_Path_Opt_Index : Natural := 0;
|
||||
|
||||
begin
|
||||
File_Path :=
|
||||
Locate_Regular_File (File_Name,
|
||||
String (Libpath.Table (1 .. Libpath.Last)));
|
||||
|
||||
if File_Path /= null then
|
||||
if GNAT_Static then
|
||||
|
||||
-- If static gnatlib found, explicitly specify to overcome
|
||||
-- possible linker default usage of shared version.
|
||||
|
||||
Linker_Options.Increment_Last;
|
||||
|
||||
Linker_Options.Table (Linker_Options.Last) :=
|
||||
new String'(File_Path.all);
|
||||
|
||||
elsif GNAT_Shared then
|
||||
if Opt.Run_Path_Option then
|
||||
|
||||
-- If shared gnatlib desired, add appropriate system specific
|
||||
-- switch so that it can be located at runtime.
|
||||
|
||||
if Run_Path_Opt'Length /= 0 then
|
||||
|
||||
-- Output the system specific linker command that allows the
|
||||
-- image activator to find the shared library at
|
||||
-- runtime. Also add path to find libgcc_s.so, if relevant.
|
||||
|
||||
declare
|
||||
Path : String (1 .. File_Path'Length + 15);
|
||||
|
||||
Path_Last : constant Natural := File_Path'Length;
|
||||
|
||||
begin
|
||||
Path (1 .. File_Path'Length) := File_Path.all;
|
||||
|
||||
-- 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 recent versions
|
||||
-- of GCC. So, we look for the last subdirectory "lib" in
|
||||
-- the path.
|
||||
|
||||
GCC_Index := Index (Path (1 .. Path_Last), "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 (Path (1 .. Path_Last), "/lib/");
|
||||
|
||||
if GCC_Index = 0 then
|
||||
GCC_Index :=
|
||||
Index (Path (1 .. Path_Last),
|
||||
Directory_Separator & "lib"
|
||||
& Directory_Separator);
|
||||
end if;
|
||||
|
||||
-- If we have found a "lib" subdir in the path to
|
||||
-- libgnat, the possible shared libgcc of interest by
|
||||
-- default is in libgcc_subdir at the same level.
|
||||
|
||||
if GCC_Index /= 0 then
|
||||
declare
|
||||
Subdir : constant String :=
|
||||
Value (Libgcc_Subdir_Ptr);
|
||||
|
||||
begin
|
||||
Path (GCC_Index + 1 .. GCC_Index + Subdir'Length)
|
||||
:= Subdir;
|
||||
GCC_Index := GCC_Index + Subdir'Length;
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Look for an eventual run_path_option in
|
||||
-- the linker switches.
|
||||
|
||||
if Separate_Run_Path_Options then
|
||||
Linker_Options.Increment_Last;
|
||||
Linker_Options.Table
|
||||
(Linker_Options.Last) :=
|
||||
new String'
|
||||
(Run_Path_Opt
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length));
|
||||
|
||||
if GCC_Index /= 0 then
|
||||
Linker_Options.Increment_Last;
|
||||
Linker_Options.Table (Linker_Options.Last) :=
|
||||
new String'
|
||||
(Run_Path_Opt
|
||||
& Path (1 .. GCC_Index));
|
||||
end if;
|
||||
|
||||
else
|
||||
for J in reverse 1 .. Linker_Options.Last loop
|
||||
if Linker_Options.Table (J) /= null
|
||||
and then
|
||||
Linker_Options.Table (J)'Length
|
||||
> Run_Path_Opt'Length
|
||||
and then
|
||||
Linker_Options.Table (J)
|
||||
(1 .. Run_Path_Opt'Length) =
|
||||
Run_Path_Opt
|
||||
then
|
||||
-- We have found an already specified
|
||||
-- run_path_option: we will add to this switch,
|
||||
-- because only one run_path_option should be
|
||||
-- specified.
|
||||
|
||||
Run_Path_Opt_Index := J;
|
||||
exit;
|
||||
end if;
|
||||
end loop;
|
||||
|
||||
-- If there is no run_path_option, we need to add one.
|
||||
|
||||
if Run_Path_Opt_Index = 0 then
|
||||
Linker_Options.Increment_Last;
|
||||
end if;
|
||||
|
||||
if GCC_Index = 0 then
|
||||
if Run_Path_Opt_Index = 0 then
|
||||
Linker_Options.Table
|
||||
(Linker_Options.Last) :=
|
||||
new String'
|
||||
(Run_Path_Opt
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length));
|
||||
|
||||
else
|
||||
Linker_Options.Table
|
||||
(Run_Path_Opt_Index) :=
|
||||
new String'
|
||||
(Linker_Options.Table
|
||||
(Run_Path_Opt_Index).all
|
||||
& Path_Separator
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length));
|
||||
end if;
|
||||
|
||||
else
|
||||
if Run_Path_Opt_Index = 0 then
|
||||
Linker_Options.Table
|
||||
(Linker_Options.Last) :=
|
||||
new String'
|
||||
(Run_Path_Opt
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length)
|
||||
& Path_Separator
|
||||
& Path (1 .. GCC_Index));
|
||||
|
||||
else
|
||||
Linker_Options.Table
|
||||
(Run_Path_Opt_Index) :=
|
||||
new String'
|
||||
(Linker_Options.Table
|
||||
(Run_Path_Opt_Index).all
|
||||
& Path_Separator
|
||||
& File_Path
|
||||
(1 .. File_Path'Length
|
||||
- File_Name'Length)
|
||||
& Path_Separator
|
||||
& Path (1 .. GCC_Index));
|
||||
end if;
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
-- Then we add the appropriate -l switch
|
||||
|
||||
Linker_Options.Increment_Last;
|
||||
Linker_Options.Table (Linker_Options.Last) :=
|
||||
new String'(Next_Line (Nfirst .. Nlast));
|
||||
end if;
|
||||
|
||||
else
|
||||
-- If gnatlib library not found, then add it anyway in
|
||||
-- case some other mechanism may find it.
|
||||
|
||||
Linker_Options.Increment_Last;
|
||||
Linker_Options.Table (Linker_Options.Last) :=
|
||||
new String'(Next_Line (Nfirst .. Nlast));
|
||||
end if;
|
||||
end Search_Library_Path;
|
||||
|
||||
-----------
|
||||
-- Usage --
|
||||
-----------
|
||||
@ -1748,10 +1753,6 @@ begin
|
||||
Fname : constant String := Base_Name (Ali_File_Name.all);
|
||||
Fname_Len : Integer := Fname'Length;
|
||||
|
||||
function Get_Maximum_File_Name_Length return Integer;
|
||||
pragma Import (C, Get_Maximum_File_Name_Length,
|
||||
"__gnat_get_maximum_file_name_length");
|
||||
|
||||
Maximum_File_Name_Length : constant Integer :=
|
||||
Get_Maximum_File_Name_Length;
|
||||
|
||||
|
||||
@ -1451,7 +1451,7 @@ package body Inline is
|
||||
-- Skip inlining if the function returns an unconstrained type
|
||||
-- using an extended return statement, since this part of the
|
||||
-- new inlining model is not yet supported by the current
|
||||
-- implementation. ???
|
||||
-- implementation.
|
||||
|
||||
or else (Returns_Unconstrained_Type (Spec_Id)
|
||||
and then Has_Extended_Return)
|
||||
@ -1531,7 +1531,6 @@ package body Inline is
|
||||
|
||||
function Is_Unit_Subprogram (Id : Entity_Id) return Boolean;
|
||||
-- Return True if subprogram Id defines a compilation unit
|
||||
-- Shouldn't this be in Sem_Aux???
|
||||
|
||||
function In_Package_Spec (Id : Entity_Id) return Boolean;
|
||||
-- Return True if subprogram Id is defined in the package specification,
|
||||
@ -2161,10 +2160,7 @@ package body Inline is
|
||||
Body_To_Inline :=
|
||||
Copy_Generic_Node (N, Empty, Instantiating => True);
|
||||
else
|
||||
-- ??? Shouldn't this use New_Copy_Tree? What about global
|
||||
-- references captured in the body to inline?
|
||||
|
||||
Body_To_Inline := Copy_Separate_Tree (N);
|
||||
Body_To_Inline := New_Copy_Tree (N);
|
||||
end if;
|
||||
|
||||
-- Remove aspects/pragmas that have no meaning in an inlined body
|
||||
@ -3554,7 +3550,6 @@ package body Inline is
|
||||
procedure Reset_Dispatching_Calls (N : Node_Id) is
|
||||
|
||||
function Do_Reset (N : Node_Id) return Traverse_Result;
|
||||
-- Comment required ???
|
||||
|
||||
--------------
|
||||
-- Do_Reset --
|
||||
@ -3620,7 +3615,6 @@ package body Inline is
|
||||
|
||||
-- If the context is an assignment, and the left-hand side is free of
|
||||
-- side-effects, the replacement is also safe.
|
||||
-- Can this be generalized further???
|
||||
|
||||
elsif Nkind (Parent (N)) = N_Assignment_Statement
|
||||
and then
|
||||
|
||||
@ -235,8 +235,8 @@ package body Layout is
|
||||
Desig_Type : Entity_Id;
|
||||
|
||||
begin
|
||||
-- For string literal types, for now, kill the size always, this is
|
||||
-- because gigi does not like or need the size to be set ???
|
||||
-- For string literal types, kill the size always, because gigi does not
|
||||
-- like or need the size to be set.
|
||||
|
||||
if Ekind (E) = E_String_Literal_Subtype then
|
||||
Set_Esize (E, Uint_0);
|
||||
@ -448,7 +448,7 @@ package body Layout is
|
||||
|
||||
begin
|
||||
-- For some reason, access types can cause trouble, So let's
|
||||
-- just do this for scalar types ???
|
||||
-- just do this for scalar types.
|
||||
|
||||
if Present (CT)
|
||||
and then Is_Scalar_Type (CT)
|
||||
|
||||
@ -85,7 +85,7 @@ package body Lib.Load is
|
||||
|
||||
-- Note: for the following we should really generalize and consult the
|
||||
-- file name pattern data, but for now we just deal with the common
|
||||
-- naming cases, which is probably good enough in practice ???
|
||||
-- naming cases, which is good enough in practice.
|
||||
|
||||
-- Change .adb to .ads
|
||||
|
||||
@ -424,7 +424,7 @@ package body Lib.Load is
|
||||
-- it is part of the main extended source, otherwise reset them.
|
||||
|
||||
-- Note: it's a bit odd but PMES is False for subunits, which is why
|
||||
-- we have the OR here. Should be investigated some time???
|
||||
-- we have the OR here.
|
||||
|
||||
if PMES or Subunit then
|
||||
Restore_Config_Cunit_Boolean_Restrictions;
|
||||
@ -478,7 +478,7 @@ package body Lib.Load is
|
||||
-- installing the context. The implicit with is on this entity,
|
||||
-- not on the package it renames. This is somewhat redundant given
|
||||
-- the with_clause just created, but it simplifies subsequent
|
||||
-- expansion of the current with_clause. Optimizable ???
|
||||
-- expansion of the current with_clause.
|
||||
|
||||
if Nkind (Error_Node) = N_With_Clause
|
||||
and then Nkind (Name (Error_Node)) = N_Selected_Component
|
||||
|
||||
@ -509,8 +509,8 @@ package body Lib is
|
||||
|
||||
if Counter > Max_Iterations then
|
||||
|
||||
-- ??? Not quite right, but return a value to be able to generate
|
||||
-- SCIL files and hope for the best.
|
||||
-- In CodePeer_Mode, return a value to be able to generate SCIL
|
||||
-- files and hope for the best.
|
||||
|
||||
if CodePeer_Mode then
|
||||
return No;
|
||||
|
||||
@ -82,9 +82,6 @@ package body Live is
|
||||
function Spec_Of (N : Node_Id) return Entity_Id;
|
||||
-- Given a subprogram body N, return defining identifier of its declaration
|
||||
|
||||
-- ??? the body of this package contains no comments at all, this
|
||||
-- should be fixed.
|
||||
|
||||
-------------
|
||||
-- Body_Of --
|
||||
-------------
|
||||
|
||||
@ -27,7 +27,6 @@
|
||||
-- to build Windows DLL
|
||||
|
||||
with GNAT.OS_Lib;
|
||||
-- Should have USE here ???
|
||||
|
||||
package MDLL is
|
||||
|
||||
|
||||
@ -442,7 +442,7 @@ package Namet is
|
||||
-- The following routines operate on Global_Name_Buffer. New code should
|
||||
-- use the routines above, and declare Bounded_Strings as local
|
||||
-- variables. Existing code can be improved incrementally by removing calls
|
||||
-- to the following. ???If we eliminate all of these, we can remove
|
||||
-- to the following. If we eliminate all of these, we can remove
|
||||
-- Global_Name_Buffer. But be sure to look at namet.h first.
|
||||
|
||||
-- To see what these do, look at the bodies. They are all trivially defined
|
||||
|
||||
@ -49,10 +49,11 @@ package body Osint is
|
||||
use type CRTL.size_t;
|
||||
|
||||
Running_Program : Program_Type := Unspecified;
|
||||
-- comment required here ???
|
||||
-- Set by Set_Program to indicate which of Compiler, Binder, etc is
|
||||
-- running.
|
||||
|
||||
Program_Set : Boolean := False;
|
||||
-- comment required here ???
|
||||
-- True if Set_Program has been called; used to detect duplicate calls.
|
||||
|
||||
Std_Prefix : String_Ptr;
|
||||
-- Standard prefix, computed dynamically the first time Relocate_Path
|
||||
@ -151,9 +152,9 @@ package body Osint is
|
||||
function To_Path_String_Access
|
||||
(Path_Addr : Address;
|
||||
Path_Len : CRTL.size_t) return String_Access;
|
||||
-- Converts a C String to an Ada String. Are we doing this to avoid withing
|
||||
-- Interfaces.C.Strings ???
|
||||
-- Caller must free result.
|
||||
-- Converts a C String to an Ada String. We don't use a more general
|
||||
-- purpose facility, because we are dealing with low-level types like
|
||||
-- Address. Caller must free result.
|
||||
|
||||
function Include_Dir_Default_Prefix return String_Access;
|
||||
-- Same as exported version, except returns a String_Access
|
||||
@ -1348,11 +1349,8 @@ package body Osint is
|
||||
Lib_File : out File_Name_Type;
|
||||
Attr : out File_Attributes)
|
||||
is
|
||||
A : aliased File_Attributes;
|
||||
begin
|
||||
-- ??? seems we could use Smart_Find_File here
|
||||
Find_File (N, Library, Lib_File, A'Access);
|
||||
Attr := A;
|
||||
Smart_Find_File (N, Library, Lib_File, Attr);
|
||||
end Full_Lib_File_Name;
|
||||
|
||||
------------------------
|
||||
@ -1891,7 +1889,7 @@ package body Osint is
|
||||
Name_Len := Full_Name'Length - 1;
|
||||
Name_Buffer (1 .. Name_Len) :=
|
||||
Full_Name (1 .. Full_Name'Last - 1);
|
||||
Found := Name_Find; -- ??? Was Name_Enter, no obvious reason
|
||||
Found := Name_Find;
|
||||
end if;
|
||||
end if;
|
||||
end;
|
||||
|
||||
@ -29,11 +29,11 @@
|
||||
with Namet; use Namet;
|
||||
with Types; use Types;
|
||||
|
||||
with System; use System;
|
||||
with System; use System;
|
||||
|
||||
pragma Warnings (Off);
|
||||
-- This package is used also by gnatcoll
|
||||
with System.OS_Lib; use System.OS_Lib;
|
||||
with System.OS_Lib; use System.OS_Lib;
|
||||
pragma Warnings (On);
|
||||
|
||||
with System.Storage_Elements;
|
||||
|
||||
@ -4732,7 +4732,8 @@ package Sinfo is
|
||||
-- Conversions from floating-point to integer are only handled in
|
||||
-- the case where Float_Truncate flag set. Other conversions from
|
||||
-- floating-point to integer (involving rounding) and all conversions
|
||||
-- involving fixed-point types are handled by the expander.
|
||||
-- involving fixed-point types are handled by the expander, unless the
|
||||
-- Conversion_OK flag is set.
|
||||
|
||||
-- Sprint syntax if Float_Truncate set: X^(Y)
|
||||
-- Sprint syntax if Conversion_OK set X?(Y)
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user