-- --
-- 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- --
"""__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;
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;
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;
-- --
-- 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- --
with Sinput; use Sinput;
with Sprint; use Sprint;
with Sdefault; use Sdefault;
+with Targparm; use Targparm;
with Treepr; use Treepr;
with Types; use Types;
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.
-- --
-- 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- --
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 ";
Gcc_Path : String_Access;
Linker_Path : String_Access;
-
Output_File_Name : String_Access;
Ali_File_Name : String_Access;
Binder_Spec_Src_File : String_Access;
-- 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;
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
-- 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
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);
projects / gcc.git / commitdiff