diff options
| -rw-r--r-- | gcc/ada/bindgen.adb | 22 | ||||
| -rw-r--r-- | gcc/ada/comperr.adb | 28 | ||||
| -rw-r--r-- | gcc/ada/gnatlink.adb | 52 |
3 files changed, 94 insertions, 8 deletions
diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index fa9ad8ff6f5..475edd513f5 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -618,17 +618,27 @@ package body Bindgen is """__gnat_initialize_stack_limit"");"); end if; + -- Special processing when main program is CIL function/procedure + if VM_Target = CLI_Target and then Bind_Main_Program and then not No_Main_Subprogram then WBI (""); + -- Function case, use Set_Exit_Status to report the returned + -- status code, since that is the only mechanism available. + if ALIs.Table (ALIs.First).Main_Program = Func then WBI (" Result : Integer;"); + WBI (" procedure Set_Exit_Status (Code : Integer);"); + WBI (" pragma Import (C, Set_Exit_Status, " & + """__gnat_set_exit_status"");"); WBI (""); WBI (" function Ada_Main_Program return Integer;"); + -- Procedure case + else WBI (" procedure Ada_Main_Program;"); end if; @@ -797,12 +807,20 @@ package body Bindgen is WBI (""); Gen_Elab_Calls_Ada; + -- Case of main program is CIL function or procedure + if VM_Target = CLI_Target and then Bind_Main_Program and then not No_Main_Subprogram then + -- For function case, use Set_Exit_Status to set result + if ALIs.Table (ALIs.First).Main_Program = Func then WBI (" Result := Ada_Main_Program;"); + WBI (" Set_Exit_Status (Result);"); + + -- Procedure case + else WBI (" Ada_Main_Program;"); end if; @@ -2270,7 +2288,7 @@ package body Bindgen is if VM_Target = No_VM then Set_Main_Program_Name; - Set_String (""" & Ascii.NUL;"); + Set_String (""" & ASCII.NUL;"); else Set_String (Name_Buffer (1 .. Name_Len - 2) & """;"); end if; diff --git a/gcc/ada/comperr.adb b/gcc/ada/comperr.adb index 64ec0c7a44d..157945bb0d9 100644 --- a/gcc/ada/comperr.adb +++ b/gcc/ada/comperr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -39,6 +39,7 @@ with Output; use Output; with Sinput; use Sinput; with Sprint; use Sprint; with Sdefault; use Sdefault; +with Targparm; use Targparm; with Treepr; use Treepr; with Types; use Types; @@ -112,6 +113,31 @@ package body Comperr is Abort_In_Progress := True; + -- Generate a "standard" error message instead of a bug box in case of + -- .NET compiler, since we do not support all constructs of the + -- language. Of course ideally, we should detect this before bombing + -- on e.g. an assertion error, but in practice most of these bombs + -- are due to a legitimate case of a construct not being supported (in + -- a sense they all are, since for sure we are not supporting something + -- if we bomb!) By giving this message, we provide a more reasonable + -- practical interface, since giving scary bug boxes on unsupported + -- features is definitely not helpful. + + -- Note that the call to Error_Msg_N below sets Serious_Errors_Detected + -- to 1, so we use the regular mechanism below in order to display a + -- "compilation abandoned" message and exit, so we still know we have + -- this case (and -gnatdk can still be used to get the bug box). + + if VM_Target = CLI_Target + and then Serious_Errors_Detected = 0 + and then not Debug_Flag_K + and then Sloc (Current_Error_Node) > No_Location + then + Error_Msg_N + ("unsupported construct in this context", + Current_Error_Node); + end if; + -- If any errors have already occurred, then we guess that the abort -- may well be caused by previous errors, and we don't make too much -- fuss about it, since we want to let programmer fix the errors first. diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index d3d10edcf52..906a61abd91 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2008, 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- -- @@ -139,7 +139,7 @@ procedure Gnatlink is Gcc : String_Access := Program_Name ("gcc"); - Read_Mode : constant String := "r" & ASCII.Nul; + Read_Mode : constant String := "r" & ASCII.NUL; Begin_Info : String := "-- BEGIN Object file/option list"; End_Info : String := "-- END Object file/option list "; @@ -147,7 +147,6 @@ procedure Gnatlink is Gcc_Path : String_Access; Linker_Path : String_Access; - Output_File_Name : String_Access; Ali_File_Name : String_Access; Binder_Spec_Src_File : String_Access; @@ -160,6 +159,10 @@ procedure Gnatlink is -- Temporary file used by linker to pass list of object files on -- certain systems with limitations on size of arguments. + Lname : String_Access := null; + -- File used by linker for CLI target, used to concatenate all .il files + -- when the command line passed to ilasm is too long + Debug_Flag_Present : Boolean := False; Verbose_Mode : Boolean := False; Very_Verbose_Mode : Boolean := False; @@ -167,7 +170,7 @@ procedure Gnatlink is Ada_Bind_File : Boolean := True; -- Set to True if bind file is generated in Ada - Standard_Gcc : Boolean := True; + Standard_Gcc : Boolean := True; Compile_Bind_File : Boolean := True; -- Set to False if bind file is not to be compiled @@ -953,7 +956,42 @@ procedure Gnatlink is -- to read from a file instead of the command line is only triggered if -- a conservative threshold is passed. - if Object_List_File_Required + if VM_Target = CLI_Target + and then Link_Bytes > Link_Max + then + Lname := new String'("l~" & Base_Name (Ali_File_Name.all) & ".il"); + + for J in Objs_Begin .. Objs_End loop + Copy_File (Linker_Objects.Table (J).all, Lname.all, + Success => Closing_Status, + Mode => Append); + end loop; + + -- Add the special objects list file option together with the name + -- of the temporary file to the objects file table. + + Linker_Objects.Table (Objs_Begin) := + new String'(Value (Object_File_Option_Ptr) & Lname.all); + + -- The slots containing these object file names are then removed + -- from the objects table so they do not appear in the link. They + -- are removed by moving up the linker options and non-Ada object + -- files appearing after the Ada object list in the table. + + declare + N : Integer; + + begin + N := Objs_End - Objs_Begin + 1; + + for J in Objs_End + 1 .. Linker_Objects.Last loop + Linker_Objects.Table (J - N + 1) := Linker_Objects.Table (J); + end loop; + + Linker_Objects.Set_Last (Linker_Objects.Last - N + 1); + end; + + elsif Object_List_File_Required or else (Object_List_File_Supported and then Link_Bytes > Link_Max) then @@ -2015,6 +2053,10 @@ begin Delete (Tname); end if; + if Lname /= null then + Delete (Lname.all & ASCII.NUL); + end if; + if not Success then Error_Msg ("error when calling " & Linker_Path.all); Exit_Program (E_Fatal); |