blob: 7a732ae3122d04561321c24b7dfe2b4efb02499a [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S W I T C H - B --
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2022, 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- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Bindgen;
with Debug; use Debug;
with Osint; use Osint;
with Opt; use Opt;
with System.OS_Lib; use System.OS_Lib;
with System.WCh_Con; use System.WCh_Con;
package body Switch.B is
--------------------------
-- Scan_Binder_Switches --
--------------------------
procedure Scan_Binder_Switches (Switch_Chars : String) is
Max : constant Integer := Switch_Chars'Last;
Ptr : Integer := Switch_Chars'First;
C : Character := ' ';
function Get_Optional_Filename return String_Ptr;
-- If current character is '=', return a newly allocated string that
-- contains the remainder of the current switch (after the '='), else
-- return null.
function Get_Stack_Size (S : Character) return Int;
-- Used for -d and -D to scan stack size including handling k/m. S is
-- set to 'd' or 'D' to indicate the switch being scanned.
procedure Scan_Debug_Switches;
-- Scan out debug switches
---------------------------
-- Get_Optional_Filename --
---------------------------
function Get_Optional_Filename return String_Ptr is
Result : String_Ptr;
begin
if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
if Ptr = Max then
Bad_Switch (Switch_Chars);
else
Result := new String'(Switch_Chars (Ptr + 1 .. Max));
Ptr := Max + 1;
return Result;
end if;
end if;
return null;
end Get_Optional_Filename;
--------------------
-- Get_Stack_Size --
--------------------
function Get_Stack_Size (S : Character) return Int is
Result : Int;
begin
Scan_Pos (Switch_Chars, Max, Ptr, Result, S);
-- In the following code, we enable overflow checking since the
-- multiplication by K or M may cause overflow, which is an error.
declare
pragma Unsuppress (Overflow_Check);
begin
-- Check for additional character 'k' (for kilobytes) or 'm' (for
-- Megabytes), but only if we have not reached the end of the
-- switch string. Note that if this appears before the end of the
-- string we will get an error when we test to make sure that the
-- string is exhausted (at the end of the case).
if Ptr <= Max then
if Switch_Chars (Ptr) = 'k' then
Result := Result * 1024;
Ptr := Ptr + 1;
elsif Switch_Chars (Ptr) = 'm' then
Result := Result * (1024 * 1024);
Ptr := Ptr + 1;
end if;
end if;
exception
when Constraint_Error =>
Osint.Fail ("numeric value out of range for switch: " & S);
end;
return Result;
end Get_Stack_Size;
-------------------------
-- Scan_Debug_Switches --
-------------------------
procedure Scan_Debug_Switches is
Dot : Boolean := False;
Underscore : Boolean := False;
begin
while Ptr <= Max loop
C := Switch_Chars (Ptr);
-- Binder debug flags come in the following forms:
--
-- letter
-- . letter
-- _ letter
--
-- digit
-- . digit
-- _ digit
--
-- Note that the processing of switch -d aleady takes care of the
-- case where the first flag is a digit (default stack size).
if C in '1' .. '9' or else
C in 'a' .. 'z' or else
C in 'A' .. 'Z'
then
-- . letter
-- . digit
if Dot then
Set_Dotted_Debug_Flag (C);
Dot := False;
-- _ letter
-- _ digit
elsif Underscore then
Set_Underscored_Debug_Flag (C);
if Debug_Flag_Underscore_C then
Enable_CUDA_Expansion := True;
end if;
if Debug_Flag_Underscore_D then
Enable_CUDA_Device_Expansion := True;
end if;
if Enable_CUDA_Expansion and Enable_CUDA_Device_Expansion
then
Bad_Switch (Switch_Chars);
elsif C = 'c' then
-- specify device library name
if Ptr >= Max or else Switch_Chars (Ptr + 1) /= '=' then
Bad_Switch (Switch_Chars);
else
CUDA_Device_Library_Name :=
new String'(Switch_Chars (Ptr + 2 .. Max));
Ptr := Max;
end if;
end if;
Underscore := False;
-- letter
-- digit
else
Set_Debug_Flag (C);
end if;
elsif C = '.' then
Dot := True;
elsif C = '_' then
Underscore := True;
else
Bad_Switch (Switch_Chars);
end if;
Ptr := Ptr + 1;
end loop;
end Scan_Debug_Switches;
-- Start of processing for Scan_Binder_Switches
begin
-- Skip past the initial character (must be the switch character)
if Ptr = Max then
Bad_Switch (Switch_Chars);
else
Ptr := Ptr + 1;
end if;
-- A little check, "gnat" at the start of a switch is not allowed except
-- for the compiler
if Max >= Ptr + 3
and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
then
Osint.Fail ("invalid switch: """ & Switch_Chars & """"
& " (gnat not needed here)");
end if;
-- Loop to scan through switches given in switch string
Check_Switch : begin
C := Switch_Chars (Ptr);
case C is
-- Processing for a switch
when 'a' =>
Ptr := Ptr + 1;
Use_Pragma_Linker_Constructor := True;
-- Processing for A switch
when 'A' =>
Ptr := Ptr + 1;
Output_ALI_List := True;
ALI_List_Filename := Get_Optional_Filename;
-- Processing for b switch
when 'b' =>
Ptr := Ptr + 1;
Brief_Output := True;
-- Processing for c switch
when 'c' =>
Ptr := Ptr + 1;
Check_Only := True;
-- Processing for d switch
when 'd' =>
if Ptr = Max then
Bad_Switch (Switch_Chars);
end if;
Ptr := Ptr + 1;
C := Switch_Chars (Ptr);
-- Case where character after -d is a digit (default stack size)
if C in '0' .. '9' then
-- In this case, we process the default primary stack size
Default_Stack_Size := Get_Stack_Size ('d');
-- Case where character after -d is not digit (debug flags)
else
Scan_Debug_Switches;
end if;
-- Processing for D switch
when 'D' =>
if Ptr = Max then
Bad_Switch (Switch_Chars);
end if;
Ptr := Ptr + 1;
Default_Sec_Stack_Size := Get_Stack_Size ('D');
-- Processing for e switch
when 'e' =>
Ptr := Ptr + 1;
Elab_Dependency_Output := True;
-- Processing for E switch
when 'E' =>
-- -E is equivalent to -Ea (see below)
Exception_Tracebacks := True;
Ptr := Ptr + 1;
if Ptr <= Max then
case Switch_Chars (Ptr) is
-- -Ea sets Exception_Tracebacks
when 'a' => null;
-- -Es sets both Exception_Tracebacks and
-- Exception_Tracebacks_Symbolic.
when 's' => Exception_Tracebacks_Symbolic := True;
when others => Bad_Switch (Switch_Chars);
end case;
Ptr := Ptr + 1;
end if;
-- Processing for f switch
when 'f' =>
if Ptr = Max then
Bad_Switch (Switch_Chars);
end if;
Force_Elab_Order_File :=
new String'(Switch_Chars (Ptr + 1 .. Max));
Ptr := Max + 1;
if not Is_Regular_File (Force_Elab_Order_File.all) then
Osint.Fail (Force_Elab_Order_File.all & ": file not found");
end if;
-- Processing for F switch
when 'F' =>
Ptr := Ptr + 1;
Force_Checking_Of_Elaboration_Flags := True;
-- Processing for g switch
when 'g' =>
Ptr := Ptr + 1;
if Ptr <= Max then
C := Switch_Chars (Ptr);
if C in '0' .. '3' then
Debugger_Level :=
Character'Pos
(Switch_Chars (Ptr)) - Character'Pos ('0');
Ptr := Ptr + 1;
end if;
else
Debugger_Level := 2;
end if;
-- Processing for G switch
when 'G' =>
Ptr := Ptr + 1;
Generate_C_Code := True;
-- Processing for h switch
when 'h' =>
Ptr := Ptr + 1;
Usage_Requested := True;
-- Processing for H switch
when 'H' =>
Ptr := Ptr + 1;
Legacy_Elaboration_Order := True;
-- Processing for i switch
when 'i' =>
if Ptr = Max then
Bad_Switch (Switch_Chars);
end if;
Ptr := Ptr + 1;
C := Switch_Chars (Ptr);
if C in '1' .. '5' | '9' | 'p' | '8' | 'f' | 'n' | 'w' then
Identifier_Character_Set := C;
Ptr := Ptr + 1;
else
Bad_Switch (Switch_Chars);
end if;
-- Processing for k switch
when 'k' =>
Ptr := Ptr + 1;
Check_Elaboration_Flags := False;
-- Processing for K switch
when 'K' =>
Ptr := Ptr + 1;
Output_Linker_Option_List := True;
-- Processing for l switch
when 'l' =>
Ptr := Ptr + 1;
Elab_Order_Output := True;
-- Processing for m switch
when 'm' =>
if Ptr = Max then
Bad_Switch (Switch_Chars);
end if;
Ptr := Ptr + 1;
Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Messages, C);
-- Processing for n switch
when 'n' =>
Ptr := Ptr + 1;
Bind_Main_Program := False;
-- Note: The -L option of the binder also implies -n, so
-- any change here must also be reflected in the processing
-- for -L that is found in Gnatbind.Scan_Bind_Arg.
-- Processing for o switch
when 'o' =>
Ptr := Ptr + 1;
if Output_File_Name_Present then
Osint.Fail ("duplicate -o switch");
else
Output_File_Name_Present := True;
end if;
-- Processing for O switch
when 'O' =>
Ptr := Ptr + 1;
Output_Object_List := True;
Object_List_Filename := Get_Optional_Filename;
-- Processing for p switch
when 'p' =>
Ptr := Ptr + 1;
Pessimistic_Elab_Order := True;
-- Processing for P switch
when 'P' =>
Ptr := Ptr + 1;
CodePeer_Mode := True;
-- Processing for q switch
when 'q' =>
Ptr := Ptr + 1;
Quiet_Output := True;
-- Processing for Q switch
when 'Q' =>
if Ptr = Max then
Bad_Switch (Switch_Chars);
end if;
Ptr := Ptr + 1;
Scan_Nat
(Switch_Chars, Max, Ptr,
Quantity_Of_Default_Size_Sec_Stacks, C);
-- Processing for r switch
when 'r' =>
Ptr := Ptr + 1;
List_Restrictions := True;
-- Processing for R switch
when 'R' =>
Ptr := Ptr + 1;
List_Closure := True;
if Ptr <= Max and then Switch_Chars (Ptr) = 'a' then
Ptr := Ptr + 1;
List_Closure_All := True;
end if;
-- Processing for s switch
when 's' =>
Ptr := Ptr + 1;
All_Sources := True;
Check_Source_Files := True;
-- Processing for t switch
when 't' =>
Ptr := Ptr + 1;
Tolerate_Consistency_Errors := True;
-- Processing for T switch
when 'T' =>
if Ptr = Max then
Bad_Switch (Switch_Chars);
end if;
Ptr := Ptr + 1;
Time_Slice_Set := True;
Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value, C);
Time_Slice_Value := Time_Slice_Value * 1_000;
-- Processing for u switch
when 'u' =>
if Ptr = Max then
Bad_Switch (Switch_Chars);
end if;
Ptr := Ptr + 1;
Dynamic_Stack_Measurement := True;
Scan_Nat
(Switch_Chars,
Max,
Ptr,
Dynamic_Stack_Measurement_Array_Size,
C);
-- Processing for v switch
when 'v' =>
Ptr := Ptr + 1;
Verbose_Mode := True;
-- Processing for V switch
when 'V' =>
declare
Eq : Integer;
begin
Ptr := Ptr + 1;
Eq := Ptr;
while Eq <= Max and then Switch_Chars (Eq) /= '=' loop
Eq := Eq + 1;
end loop;
if Eq = Ptr or else Eq = Max then
Bad_Switch (Switch_Chars);
end if;
Bindgen.Set_Bind_Env
(Key => Switch_Chars (Ptr .. Eq - 1),
Value => Switch_Chars (Eq + 1 .. Max));
Ptr := Max + 1;
end;
-- Processing for w switch
when 'w' =>
if Ptr = Max then
Bad_Switch (Switch_Chars);
end if;
-- For the binder we only allow suppress/error cases
Ptr := Ptr + 1;
case Switch_Chars (Ptr) is
when 'e' =>
Warning_Mode := Treat_As_Error;
when 'E' =>
Warning_Mode := Treat_Run_Time_Warnings_As_Errors;
when 's' =>
Warning_Mode := Suppress;
when others =>
Bad_Switch (Switch_Chars);
end case;
Ptr := Ptr + 1;
-- Processing for W switch
when 'W' =>
Ptr := Ptr + 1;
if Ptr > Max then
Bad_Switch (Switch_Chars);
end if;
begin
Wide_Character_Encoding_Method :=
Get_WC_Encoding_Method (Switch_Chars (Ptr));
exception
when Constraint_Error =>
Bad_Switch (Switch_Chars);
end;
Wide_Character_Encoding_Method_Specified := True;
Upper_Half_Encoding :=
Wide_Character_Encoding_Method in WC_Upper_Half_Encoding_Method;
Ptr := Ptr + 1;
-- Processing for x switch
when 'x' =>
Ptr := Ptr + 1;
All_Sources := False;
Check_Source_Files := False;
-- Processing for X switch
when 'X' =>
if Ptr = Max then
Bad_Switch (Switch_Chars);
end if;
Ptr := Ptr + 1;
Scan_Pos (Switch_Chars, Max, Ptr, Default_Exit_Status, C);
-- Processing for y switch
when 'y' =>
Ptr := Ptr + 1;
Leap_Seconds_Support := True;
-- Processing for z switch
when 'z' =>
Ptr := Ptr + 1;
No_Main_Subprogram := True;
-- Processing for Z switch
when 'Z' =>
Ptr := Ptr + 1;
Zero_Formatting := True;
-- Processing for --RTS
when '-' =>
if Ptr + 4 <= Max and then
Switch_Chars (Ptr + 1 .. Ptr + 3) = "RTS"
then
Ptr := Ptr + 4;
if Switch_Chars (Ptr) /= '=' or else Ptr = Max then
Osint.Fail ("missing path for --RTS");
else
-- Valid --RTS switch
Opt.No_Stdinc := True;
Opt.RTS_Switch := True;
declare
Src_Path_Name : constant String_Ptr :=
Get_RTS_Search_Dir
(Switch_Chars (Ptr + 1 .. Max),
Include);
Lib_Path_Name : constant String_Ptr :=
Get_RTS_Search_Dir
(Switch_Chars (Ptr + 1 .. Max),
Objects);
begin
if Src_Path_Name /= null and then
Lib_Path_Name /= null
then
-- Set the RTS_*_Path_Name variables, so that the
-- correct directories will be set when a subsequent
-- call Osint.Add_Default_Search_Dirs is made.
RTS_Src_Path_Name := Src_Path_Name;
RTS_Lib_Path_Name := Lib_Path_Name;
Ptr := Max + 1;
elsif Src_Path_Name = null
and then Lib_Path_Name = null
then
Osint.Fail
("RTS path not valid: missing adainclude and "
& "adalib directories");
elsif Src_Path_Name = null then
Osint.Fail
("RTS path not valid: missing adainclude directory");
elsif Lib_Path_Name = null then
Osint.Fail
("RTS path not valid: missing adalib directory");
end if;
end;
end if;
else
Bad_Switch (Switch_Chars);
end if;
-- Anything else is an error (illegal switch character)
when others =>
Bad_Switch (Switch_Chars);
end case;
if Ptr <= Max then
Bad_Switch (Switch_Chars);
end if;
end Check_Switch;
end Scan_Binder_Switches;
end Switch.B;