-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2011, 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 Atree; use Atree;
with Debug; use Debug;
with Elists; use Elists;
+with Errout; use Errout;
with Lib; use Lib;
with Osint; use Osint;
with Opt; use Opt;
with System; use System;
with Types; use Types;
+with System.OS_Lib; use System.OS_Lib;
+
package body Back_End is
+ type Arg_Array is array (Nat) of Big_String_Ptr;
+ type Arg_Array_Ptr is access Arg_Array;
+ -- Types to access compiler arguments
+
+ flag_stack_check : Int;
+ pragma Import (C, flag_stack_check);
+ -- Indicates if stack checking is enabled, imported from decl.c
+
+ save_argc : Nat;
+ pragma Import (C, save_argc);
+ -- Saved value of argc (number of arguments), imported from misc.c
+
+ save_argv : Arg_Array_Ptr;
+ pragma Import (C, save_argv);
+ -- Saved value of argv (argument pointers), imported from misc.c
+
+ function Len_Arg (Arg : Pos) return Nat;
+ -- Determine length of argument number Arg on original gnat1 command line
+
-------------------
-- Call_Back_End --
-------------------
number_file : Nat;
file_info_ptr : Address;
+ gigi_standard_boolean : Entity_Id;
gigi_standard_integer : Entity_Id;
+ gigi_standard_character : Entity_Id;
gigi_standard_long_long_float : Entity_Id;
gigi_standard_exception_type : Entity_Id;
gigi_operating_mode : Back_End_Mode_Type);
return;
end if;
+ -- The back end needs to know the maximum line number that can appear
+ -- in a Sloc, in other words the maximum logical line number.
+
for J in 1 .. Last_Source_File loop
File_Info_Array (J).File_Name := Full_Debug_Name (J);
- File_Info_Array (J).Num_Source_Lines := Num_Source_Lines (J);
+ File_Info_Array (J).Num_Source_Lines :=
+ Nat (Physical_To_Logical (Last_Source_Line (J), J));
end loop;
+ if Generate_SCIL then
+ Error_Msg_N ("'S'C'I'L generation not available", Cunit (Main_Unit));
+
+ if CodePeer_Mode
+ or else (Mode /= Generate_Object
+ and then not Back_Annotate_Rep_Info)
+ then
+ return;
+ end if;
+ end if;
+
gigi
(gnat_root => Int (Cunit (Main_Unit)),
max_gnat_node => Int (Last_Node_Id - First_Node_Id + 1),
number_file => Num_Source_Files,
file_info_ptr => File_Info_Array'Address,
+ gigi_standard_boolean => Standard_Boolean,
gigi_standard_integer => Standard_Integer,
+ gigi_standard_character => Standard_Character,
gigi_standard_long_long_float => Standard_Long_Long_Float,
gigi_standard_exception_type => Standard_Exception_Type,
gigi_operating_mode => Mode);
end Call_Back_End;
+ -------------
+ -- Len_Arg --
+ -------------
+
+ function Len_Arg (Arg : Pos) return Nat is
+ begin
+ for J in 1 .. Nat'Last loop
+ if save_argv (Arg).all (Natural (J)) = ASCII.NUL then
+ return J - 1;
+ end if;
+ end loop;
+
+ raise Program_Error;
+ end Len_Arg;
+
-----------------------------
-- Scan_Compiler_Arguments --
-----------------------------
procedure Scan_Compiler_Arguments is
- Next_Arg : Pos := 1;
-
- type Arg_Array is array (Nat) of Big_String_Ptr;
- type Arg_Array_Ptr is access Arg_Array;
- flag_stack_check : Int;
- pragma Import (C, flag_stack_check);
- -- Import from toplev.c
-
- save_argc : Nat;
- pragma Import (C, save_argc);
- -- Import from toplev.c
-
- save_argv : Arg_Array_Ptr;
- pragma Import (C, save_argv);
- -- Import from toplev.c
+ Next_Arg : Positive;
+ -- Next argument to be scanned
Output_File_Name_Seen : Boolean := False;
-- Set to True after having scanned file_name for switch "-gnatO file"
- -- Local functions
-
- function Len_Arg (Arg : Pos) return Nat;
- -- Determine length of argument number Arg on the original command line
- -- from gnat1.
-
procedure Scan_Back_End_Switches (Switch_Chars : String);
-- Procedure to scan out switches stored in Switch_Chars. The first
-- character is known to be a valid switch character, and there are no
-- entire string should consist of valid switch characters, except that
-- an optional terminating NUL character is allowed.
--
- -- Back end switches have already been checked and processed by GCC
- -- in toplev.c, so no errors can occur and control will always return.
- -- The switches must still be scanned to skip the arguments of the
- -- "-o" or the (undocumented) "-dumpbase" switch, by incrementing
- -- the Next_Arg variable. The "-dumpbase" switch is used to set the
- -- basename for GCC dumpfiles.
-
- -------------
- -- Len_Arg --
- -------------
-
- function Len_Arg (Arg : Pos) return Nat is
- begin
- for J in 1 .. Nat'Last loop
- if save_argv (Arg).all (Natural (J)) = ASCII.NUL then
- return J - 1;
- end if;
- end loop;
-
- raise Program_Error;
- end Len_Arg;
+ -- Back end switches have already been checked and processed by GCC in
+ -- toplev.c, so no errors can occur and control will always return. The
+ -- switches must still be scanned to skip "-o" or internal GCC switches
+ -- with their argument.
----------------------------
-- Scan_Back_End_Switches --
procedure Scan_Back_End_Switches (Switch_Chars : String) is
First : constant Positive := Switch_Chars'First + 1;
- Last : Natural := Switch_Chars'Last;
+ Last : constant Natural := Switch_Last (Switch_Chars);
begin
- if Last >= First
- and then Switch_Chars (Last) = ASCII.NUL
- then
- Last := Last - 1;
- end if;
-
- -- For switches -o, -dumpbase, --param, skip following argument and
- -- do not store either the switch or the following argument.
+ -- Skip -o or internal GCC switches together with their argument
- if Switch_Chars (First .. Last) = "o" or else
- Switch_Chars (First .. Last) = "dumpbase" or else
- Switch_Chars (First .. Last) = "-param"
+ if Switch_Chars (First .. Last) = "o"
+ or else Is_Internal_GCC_Switch (Switch_Chars)
then
Next_Arg := Next_Arg + 1;
if Switch_Chars (First .. Last) = "fno-inline" then
Opt.Suppress_All_Inlining := True;
+
+ -- Another special check, the switch -fpreserve-control-flow
+ -- which is also a back end switch sets the front end flag
+ -- that inhibits improper control flow transformations.
+
+ elsif Switch_Chars (First .. Last) = "fpreserve-control-flow" then
+ Opt.Suppress_Control_Flow_Optimizations := True;
end if;
end if;
end Scan_Back_End_Switches;
+ -- Local variables
+
+ Arg_Count : constant Natural := Natural (save_argc - 1);
+ Args : Argument_List (1 .. Arg_Count);
+
-- Start of processing for Scan_Compiler_Arguments
begin
Opt.Stack_Checking_Enabled := (flag_stack_check /= 0);
- -- Loop through command line arguments, storing them for later access
+ -- Put the arguments in Args
- while Next_Arg < save_argc loop
- Look_At_Arg : declare
- Argv_Ptr : constant Big_String_Ptr := save_argv (Next_Arg);
- Argv_Len : constant Nat := Len_Arg (Next_Arg);
+ for Arg in Pos range 1 .. save_argc - 1 loop
+ declare
+ Argv_Ptr : constant Big_String_Ptr := save_argv (Arg);
+ Argv_Len : constant Nat := Len_Arg (Arg);
Argv : constant String :=
Argv_Ptr (1 .. Natural (Argv_Len));
+ begin
+ Args (Positive (Arg)) := new String'(Argv);
+ end;
+ end loop;
+
+ -- Loop through command line arguments, storing them for later access
+
+ Next_Arg := 1;
+ while Next_Arg <= Args'Last loop
+ Look_At_Arg : declare
+ Argv : constant String := Args (Next_Arg).all;
begin
-- If the previous switch has set the Output_File_Name_Present
Opt.No_Stdlib := True;
elsif Is_Front_End_Switch (Argv) then
- Scan_Front_End_Switches (Argv);
+ Scan_Front_End_Switches (Argv, Args, Next_Arg);
-- All non-front-end switches are back-end switches
end loop;
end Scan_Compiler_Arguments;
+ -----------------------------
+ -- Register_Back_End_Types --
+ -----------------------------
+
+ procedure Register_Back_End_Types (Call_Back : Register_Type_Proc) is
+ procedure Enumerate_Modes (Call_Back : Register_Type_Proc);
+ pragma Import (C, Enumerate_Modes, "enumerate_modes");
+
+ begin
+ Enumerate_Modes (Call_Back);
+ end Register_Back_End_Types;
+
+ -------------------------------
+ -- Gen_Or_Update_Object_File --
+ -------------------------------
+
+ procedure Gen_Or_Update_Object_File is
+ begin
+ null;
+ end Gen_Or_Update_Object_File;
+
end Back_End;
OSDN Git Service
