diff options
| -rw-r--r-- | gcc/ada/binde.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/bindo-writers.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/debug_a.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/errout.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 66 | ||||
| -rw-r--r-- | gcc/ada/gnatchop.adb | 5 | ||||
| -rw-r--r-- | gcc/ada/gnatdll.adb | 7 | ||||
| -rw-r--r-- | gcc/ada/gnatlink.adb | 595 | ||||
| -rw-r--r-- | gcc/ada/inline.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/layout.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/lib-load.adb | 6 | ||||
| -rw-r--r-- | gcc/ada/lib.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/live.adb | 3 | ||||
| -rw-r--r-- | gcc/ada/mdll.ads | 1 | ||||
| -rw-r--r-- | gcc/ada/namet.ads | 2 | ||||
| -rw-r--r-- | gcc/ada/osint.adb | 18 | ||||
| -rw-r--r-- | gcc/ada/osint.ads | 4 | ||||
| -rw-r--r-- | gcc/ada/sinfo.ads | 3 |
18 files changed, 357 insertions, 415 deletions
diff --git a/gcc/ada/binde.adb b/gcc/ada/binde.adb index d58455c..3df78bf 100644 --- a/gcc/ada/binde.adb +++ b/gcc/ada/binde.adb @@ -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; diff --git a/gcc/ada/bindo-writers.adb b/gcc/ada/bindo-writers.adb index 9c82303..b124a42 100644 --- a/gcc/ada/bindo-writers.adb +++ b/gcc/ada/bindo-writers.adb @@ -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 diff --git a/gcc/ada/debug_a.adb b/gcc/ada/debug_a.adb index 76e2371..c92cbd4 100644 --- a/gcc/ada/debug_a.adb +++ b/gcc/ada/debug_a.adb @@ -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); diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 3541a77..855723a 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -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; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 35f870a..5b0ba19 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -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 diff --git a/gcc/ada/gnatchop.adb b/gcc/ada/gnatchop.adb index 2ece513..8f3048c 100644 --- a/gcc/ada/gnatchop.adb +++ b/gcc/ada/gnatchop.adb @@ -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; diff --git a/gcc/ada/gnatdll.adb b/gcc/ada/gnatdll.adb index 548c433..ce90cc2 100644 --- a/gcc/ada/gnatdll.adb +++ b/gcc/ada/gnatdll.adb @@ -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; diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index 453efb6..52e714a 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -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,268 +1126,262 @@ 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 ??? + else + Linker_Options.Increment_Last; + Linker_Options.Table (Linker_Options.Last) := + new String'(Next_Line (Nfirst .. Nlast)); + end if; + end if; - declare - File_Path : String_Access; + Xlinker_Was_Previous := Next_Line (Nfirst .. Nlast) = "-Xlinker"; + + Get_Next_Line; + exit when Next_Line (Nfirst .. Nlast) = End_Info; + + Next_Line (Nfirst .. Nlast - 8) := Next_Line (Nfirst + 8 .. Nlast); + Nlast := Nlast - 8; + end loop; + end if; + + -- If -shared was specified, invoke gcc with -shared-libgcc + + if GNAT_Shared then + Linker_Options.Increment_Last; + Linker_Options.Table (Linker_Options.Last) := Shared_Libgcc; + end if; - Object_Lib_Extension : constant String := - Value (Object_Library_Ext_Ptr); + 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; - File_Name : constant String := "lib" & - Next_Line (Nfirst + 2 .. Last) & Object_Lib_Extension; + Object_Lib_Extension : constant String := + Value (Object_Library_Ext_Ptr); - Run_Path_Opt : constant String := - Value (Run_Path_Option_Ptr); + File_Name : constant String := "lib" & + Next_Line (Nfirst + 2 .. Last) & Object_Lib_Extension; - GCC_Index : Natural; - Run_Path_Opt_Index : Natural := 0; + 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 - File_Path := - Locate_Regular_File (File_Name, - String (Libpath.Table (1 .. Libpath.Last))); + Path (1 .. File_Path'Length) := File_Path.all; - if File_Path /= null then - if GNAT_Static then + -- 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. - -- If static gnatlib found, explicitly specify to - -- overcome possible linker default usage of shared - -- version. + GCC_Index := Index (Path (1 .. Path_Last), "gcc-lib"); - Linker_Options.Increment_Last; + if GCC_Index /= 0 then - 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; + -- The shared version of libgcc is located in the + -- parent directory. - -- Then we add the appropriate -l switch + 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'(Next_Line (Nfirst .. Nlast)); + new String' + (Run_Path_Opt + & Path (1 .. GCC_Index)); end if; else - -- If gnatlib library not found, then add it anyway in - -- case some other mechanism may find it. + 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. - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - new String'(Next_Line (Nfirst .. Nlast)); + 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; - else - Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := - new String'(Next_Line (Nfirst .. Nlast)); end if; end if; - Xlinker_Was_Previous := Next_Line (Nfirst .. Nlast) = "-Xlinker"; - - Get_Next_Line; - exit when Next_Line (Nfirst .. Nlast) = End_Info; + -- Then we add the appropriate -l switch - Next_Line (Nfirst .. Nlast - 8) := Next_Line (Nfirst + 8 .. Nlast); - Nlast := Nlast - 8; - end loop; - end if; + Linker_Options.Increment_Last; + Linker_Options.Table (Linker_Options.Last) := + new String'(Next_Line (Nfirst .. Nlast)); + end if; - -- If -shared was specified, invoke gcc with -shared-libgcc + else + -- If gnatlib library not found, then add it anyway in + -- case some other mechanism may find it. - if GNAT_Shared then Linker_Options.Increment_Last; - Linker_Options.Table (Linker_Options.Last) := Shared_Libgcc; + Linker_Options.Table (Linker_Options.Last) := + new String'(Next_Line (Nfirst .. Nlast)); end if; - - Status := fclose (Fd); - end Process_Binder_File; + 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; diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index c14d264..91a8bf2 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -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 diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index ce0a0d8..42f29d7 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -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) diff --git a/gcc/ada/lib-load.adb b/gcc/ada/lib-load.adb index 0950be6..f561b6d 100644 --- a/gcc/ada/lib-load.adb +++ b/gcc/ada/lib-load.adb @@ -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 diff --git a/gcc/ada/lib.adb b/gcc/ada/lib.adb index ccc23ff..1aeedad 100644 --- a/gcc/ada/lib.adb +++ b/gcc/ada/lib.adb @@ -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; diff --git a/gcc/ada/live.adb b/gcc/ada/live.adb index 2b78355..91ea7bb 100644 --- a/gcc/ada/live.adb +++ b/gcc/ada/live.adb @@ -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 -- ------------- diff --git a/gcc/ada/mdll.ads b/gcc/ada/mdll.ads index 3cab3be..a134ae4 100644 --- a/gcc/ada/mdll.ads +++ b/gcc/ada/mdll.ads @@ -27,7 +27,6 @@ -- to build Windows DLL with GNAT.OS_Lib; --- Should have USE here ??? package MDLL is diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index 799a211..00987ad 100644 --- a/gcc/ada/namet.ads +++ b/gcc/ada/namet.ads @@ -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 diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index 4248e4b5..ea52a7a 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -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; diff --git a/gcc/ada/osint.ads b/gcc/ada/osint.ads index a0c7b6a..8dfa7c2 100644 --- a/gcc/ada/osint.ads +++ b/gcc/ada/osint.ads @@ -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; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 7f60049..d952b3c 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -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) |