with Debug; use Debug;
with Osint; use Osint;
with Opt; use Opt;
with Validsw; use Validsw;
with Stylesw; use Stylesw;
with Types; use Types;
with System.WCh_Con; use System.WCh_Con;
package body Switch is
Bad_Switch : exception;
Bad_Switch_Value : exception;
Missing_Switch_Value : exception;
Too_Many_Output_Files : exception;
Switch_Max_Value : constant := 999;
procedure Scan_Nat
(Switch_Chars : String;
Max : Integer;
Ptr : in out Integer;
Result : out Nat);
procedure Scan_Pos
(Switch_Chars : String;
Max : Integer;
Ptr : in out Integer;
Result : out Pos);
function Is_Front_End_Switch (Switch_Chars : String) return Boolean is
Ptr : constant Positive := Switch_Chars'First;
begin
return Is_Switch (Switch_Chars)
and then
(Switch_Chars (Ptr + 1) = 'I'
or else
(Switch_Chars'Length >= 5
and then Switch_Chars (Ptr + 1 .. Ptr + 4) = "gnat"));
end Is_Front_End_Switch;
function Is_Switch (Switch_Chars : String) return Boolean is
begin
return Switch_Chars'Length > 1
and then (Switch_Chars (Switch_Chars'First) = '-'
or
Switch_Chars (Switch_Chars'First) = Switch_Character);
end Is_Switch;
procedure Scan_Binder_Switches (Switch_Chars : String) is
Ptr : Integer := Switch_Chars'First;
Max : Integer := Switch_Chars'Last;
C : Character := ' ';
begin
if Ptr = Max then
raise Bad_Switch;
else
Ptr := Ptr + 1;
end if;
if Switch_Chars'Last >= Ptr + 3
and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
then
Osint.Fail ("invalid switch: """, Switch_Chars, """"
& " (gnat not needed here)");
end if;
while Ptr <= Max loop
C := Switch_Chars (Ptr);
case C is
when 'A' =>
Ptr := Ptr + 1;
Ada_Bind_File := True;
when 'b' =>
Ptr := Ptr + 1;
Brief_Output := True;
when 'c' =>
Ptr := Ptr + 1;
Check_Only := True;
when 'C' =>
Ptr := Ptr + 1;
Ada_Bind_File := False;
when 'd' =>
while Ptr < Max loop
Ptr := Ptr + 1;
C := Switch_Chars (Ptr);
exit when C = ASCII.NUL or else C = '/' or else C = '-';
if C in '1' .. '9' or else
C in 'a' .. 'z' or else
C in 'A' .. 'Z'
then
Set_Debug_Flag (C);
else
raise Bad_Switch;
end if;
end loop;
if Debug_Flag_XX then
Zero_Cost_Exceptions_Set := True;
Zero_Cost_Exceptions_Val := True;
end if;
return;
when 'e' =>
Ptr := Ptr + 1;
Elab_Dependency_Output := True;
when 'E' =>
Ptr := Ptr + 1;
Exception_Tracebacks := True;
when 'f' =>
Ptr := Ptr + 1;
Force_RM_Elaboration_Order := True;
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;
when 'G' =>
Ptr := Ptr + 1;
Print_Generated_Code := True;
when 'h' =>
Ptr := Ptr + 1;
Usage_Requested := True;
when 'i' =>
if Ptr = Max then
raise Bad_Switch;
end if;
Ptr := Ptr + 1;
C := Switch_Chars (Ptr);
if C in '1' .. '5'
or else C = '8'
or else C = 'p'
or else C = 'f'
or else C = 'n'
or else C = 'w'
then
Identifier_Character_Set := C;
Ptr := Ptr + 1;
else
raise Bad_Switch;
end if;
when 'K' =>
Ptr := Ptr + 1;
if Program = Binder then
Output_Linker_Option_List := True;
else
raise Bad_Switch;
end if;
when 'l' =>
Ptr := Ptr + 1;
Elab_Order_Output := True;
when 'm' =>
Ptr := Ptr + 1;
Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors);
when 'n' =>
Ptr := Ptr + 1;
Bind_Main_Program := False;
when 'o' =>
Ptr := Ptr + 1;
if Output_File_Name_Present then
raise Too_Many_Output_Files;
else
Output_File_Name_Present := True;
end if;
when 'O' =>
Ptr := Ptr + 1;
Output_Object_List := True;
when 'p' =>
Ptr := Ptr + 1;
Pessimistic_Elab_Order := True;
when 'q' =>
Ptr := Ptr + 1;
Quiet_Output := True;
when 's' =>
Ptr := Ptr + 1;
All_Sources := True;
Check_Source_Files := True;
when 't' =>
Ptr := Ptr + 1;
Tolerate_Consistency_Errors := True;
when 'T' =>
Ptr := Ptr + 1;
Time_Slice_Set := True;
Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value);
when 'v' =>
Ptr := Ptr + 1;
Verbose_Mode := True;
when 'w' =>
Ptr := Ptr + 1;
case Switch_Chars (Ptr) is
when 'e' =>
Warning_Mode := Treat_As_Error;
when 's' =>
Warning_Mode := Suppress;
when others =>
raise Bad_Switch;
end case;
Ptr := Ptr + 1;
when 'W' =>
Ptr := Ptr + 1;
for J in WC_Encoding_Method loop
if Switch_Chars (Ptr) = WC_Encoding_Letters (J) then
Wide_Character_Encoding_Method := J;
exit;
elsif J = WC_Encoding_Method'Last then
raise Bad_Switch;
end if;
end loop;
Upper_Half_Encoding :=
Wide_Character_Encoding_Method in
WC_Upper_Half_Encoding_Method;
Ptr := Ptr + 1;
when 'x' =>
Ptr := Ptr + 1;
All_Sources := False;
Check_Source_Files := False;
when 'z' =>
Ptr := Ptr + 1;
No_Main_Subprogram := True;
when '/' | '-' =>
Ptr := Ptr + 1;
when others =>
raise Bad_Switch;
end case;
end loop;
exception
when Bad_Switch =>
Osint.Fail ("invalid switch: ", (1 => C));
when Bad_Switch_Value =>
Osint.Fail ("numeric value too big for switch: ", (1 => C));
when Missing_Switch_Value =>
Osint.Fail ("missing numeric value for switch: ", (1 => C));
when Too_Many_Output_Files =>
Osint.Fail ("duplicate -o switch");
end Scan_Binder_Switches;
procedure Scan_Front_End_Switches (Switch_Chars : String) is
Switch_Starts_With_Gnat : Boolean;
Ptr : Integer := Switch_Chars'First;
Max : constant Integer := Switch_Chars'Last;
C : Character := ' ';
begin
if Ptr = Max then
raise Bad_Switch;
else
Ptr := Ptr + 1;
end if;
Switch_Starts_With_Gnat :=
Ptr + 3 <= Max and then Switch_Chars (Ptr .. Ptr + 3) = "gnat";
if Switch_Starts_With_Gnat then
Ptr := Ptr + 4;
end if;
while Ptr <= Max loop
C := Switch_Chars (Ptr);
case Switch_Starts_With_Gnat is
when False =>
case C is
when 'I' =>
Ptr := Ptr + 1;
if Ptr > Max then
raise Bad_Switch;
end if;
if Ptr = Max and then Switch_Chars (Ptr) = '-' then
Look_In_Primary_Dir := False;
else
Add_Src_Search_Dir (Switch_Chars (Ptr .. Max));
end if;
Ptr := Max + 1;
when others =>
raise Bad_Switch;
end case;
when True =>
case C is
when 'a' =>
Ptr := Ptr + 1;
Assertions_Enabled := True;
when 'A' =>
Ptr := Ptr + 1;
Config_File := False;
when 'b' =>
Ptr := Ptr + 1;
Brief_Output := True;
when 'c' =>
Ptr := Ptr + 1;
Operating_Mode := Check_Semantics;
when 'C' =>
Ptr := Ptr + 1;
Compress_Debug_Names := True;
when 'd' =>
while Ptr < Max loop
Ptr := Ptr + 1;
C := Switch_Chars (Ptr);
exit when C = ASCII.NUL or else C = '/' or else C = '-';
if C in '1' .. '9' or else
C in 'a' .. 'z' or else
C in 'A' .. 'Z'
then
Set_Debug_Flag (C);
else
raise Bad_Switch;
end if;
end loop;
if Debug_Flag_XX then
Zero_Cost_Exceptions_Set := True;
Zero_Cost_Exceptions_Val := True;
end if;
return;
when 'D' =>
Ptr := Ptr + 1;
Debug_Generated_Code := True;
Xref_Active := False;
Set_Debug_Flag ('g');
when 'e' =>
Ptr := Ptr + 1;
if Ptr > Max then
raise Bad_Switch;
end if;
case Switch_Chars (Ptr) is
when 'c' =>
Ptr := Ptr + 1;
if Ptr > Max then
raise Bad_Switch;
end if;
Config_File_Name :=
new String'(Switch_Chars (Ptr .. Max));
return;
when 'm' =>
Ptr := Ptr + 1;
if Ptr > Max then
raise Bad_Switch;
end if;
Mapping_File_Name :=
new String'(Switch_Chars (Ptr .. Max));
return;
when others =>
raise Bad_Switch;
end case;
when 'E' =>
Ptr := Ptr + 1;
Dynamic_Elaboration_Checks := True;
when 'f' =>
Ptr := Ptr + 1;
All_Errors_Mode := True;
when 'F' =>
Ptr := Ptr + 1;
External_Name_Exp_Casing := Uppercase;
External_Name_Imp_Casing := Uppercase;
when 'g' =>
Ptr := Ptr + 1;
GNAT_Mode := True;
Identifier_Character_Set := 'n';
Warning_Mode := Treat_As_Error;
Check_Unreferenced := True;
Check_Withs := True;
Set_Default_Style_Check_Options;
when 'G' =>
Ptr := Ptr + 1;
Print_Generated_Code := True;
when 'h' =>
Ptr := Ptr + 1;
Usage_Requested := True;
when 'H' =>
Ptr := Ptr + 1;
HLO_Active := True;
when 'i' =>
if Ptr = Max then
raise Bad_Switch;
end if;
Ptr := Ptr + 1;
C := Switch_Chars (Ptr);
if C in '1' .. '5'
or else C = '8'
or else C = 'p'
or else C = 'f'
or else C = 'n'
or else C = 'w'
then
Identifier_Character_Set := C;
Ptr := Ptr + 1;
else
raise Bad_Switch;
end if;
when 'k' =>
Ptr := Ptr + 1;
Scan_Pos (Switch_Chars, Max, Ptr, Maximum_File_Name_Length);
when 'l' =>
Ptr := Ptr + 1;
Full_List := True;
when 'L' =>
Ptr := Ptr + 1;
Zero_Cost_Exceptions_Set := True;
Zero_Cost_Exceptions_Val := False;
when 'm' =>
Ptr := Ptr + 1;
Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors);
when 'n' =>
Ptr := Ptr + 1;
Inline_Active := True;
when 'N' =>
Ptr := Ptr + 1;
Inline_Active := True;
Front_End_Inlining := True;
when 'o' =>
Ptr := Ptr + 1;
Suppress_Options.Overflow_Checks := False;
when 'O' =>
Ptr := Ptr + 1;
Output_File_Name_Present := True;
when 'p' =>
Ptr := Ptr + 1;
Suppress_Options.Access_Checks := True;
Suppress_Options.Accessibility_Checks := True;
Suppress_Options.Discriminant_Checks := True;
Suppress_Options.Division_Checks := True;
Suppress_Options.Elaboration_Checks := True;
Suppress_Options.Index_Checks := True;
Suppress_Options.Length_Checks := True;
Suppress_Options.Overflow_Checks := True;
Suppress_Options.Range_Checks := True;
Suppress_Options.Division_Checks := True;
Suppress_Options.Length_Checks := True;
Suppress_Options.Range_Checks := True;
Suppress_Options.Storage_Checks := True;
Suppress_Options.Tag_Checks := True;
Validity_Checks_On := False;
when 'P' =>
Ptr := Ptr + 1;
Polling_Required := True;
when 'q' =>
Ptr := Ptr + 1;
Try_Semantics := True;
when 'Q' =>
Ptr := Ptr + 1;
Force_ALI_Tree_File := True;
Try_Semantics := True;
when 'r' =>
Ptr := Ptr + 1;
Set_Style_Check_Options ("l");
when 'R' =>
Ptr := Ptr + 1;
Back_Annotate_Rep_Info := True;
if Ptr <= Max
and then Switch_Chars (Ptr) in '0' .. '9'
then
C := Switch_Chars (Ptr);
if C in '4' .. '9' then
raise Bad_Switch;
else
List_Representation_Info :=
Character'Pos (C) - Character'Pos ('0');
Ptr := Ptr + 1;
end if;
else
List_Representation_Info := 1;
end if;
when 's' =>
Ptr := Ptr + 1;
Operating_Mode := Check_Syntax;
when 't' =>
Ptr := Ptr + 1;
Tree_Output := True;
Back_Annotate_Rep_Info := True;
when 'T' =>
Ptr := Ptr + 1;
Time_Slice_Set := True;
Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value);
when 'u' =>
Ptr := Ptr + 1;
List_Units := True;
when 'U' =>
Ptr := Ptr + 1;
Unique_Error_Tag := True;
when 'v' =>
Ptr := Ptr + 1;
Verbose_Mode := True;
when 'V' =>
Ptr := Ptr + 1;
if Ptr > Max then
raise Bad_Switch;
else
declare
OK : Boolean;
begin
Set_Validity_Check_Options
(Switch_Chars (Ptr .. Max), OK, Ptr);
if not OK then
raise Bad_Switch;
end if;
end;
end if;
when 'w' =>
Ptr := Ptr + 1;
if Ptr > Max then
raise Bad_Switch;
end if;
while Ptr <= Max loop
C := Switch_Chars (Ptr);
case C is
when 'a' =>
Constant_Condition_Warnings := True;
Elab_Warnings := True;
Check_Unreferenced := True;
Check_Withs := True;
Implementation_Unit_Warnings := True;
Ineffective_Inline_Warnings := True;
Warn_On_Redundant_Constructs := True;
when 'A' =>
Constant_Condition_Warnings := False;
Elab_Warnings := False;
Check_Unreferenced := False;
Check_Withs := False;
Implementation_Unit_Warnings := False;
Warn_On_Biased_Rounding := False;
Warn_On_Hiding := False;
Warn_On_Redundant_Constructs := False;
Ineffective_Inline_Warnings := False;
when 'c' =>
Constant_Condition_Warnings := True;
when 'C' =>
Constant_Condition_Warnings := False;
when 'b' =>
Warn_On_Biased_Rounding := True;
when 'B' =>
Warn_On_Biased_Rounding := False;
when 'e' =>
Warning_Mode := Treat_As_Error;
when 'h' =>
Warn_On_Hiding := True;
when 'H' =>
Warn_On_Hiding := False;
when 'i' =>
Implementation_Unit_Warnings := True;
when 'I' =>
Implementation_Unit_Warnings := False;
when 'l' =>
Elab_Warnings := True;
when 'L' =>
Elab_Warnings := False;
when 'o' =>
Address_Clause_Overlay_Warnings := True;
when 'O' =>
Address_Clause_Overlay_Warnings := False;
when 'p' =>
Ineffective_Inline_Warnings := True;
when 'P' =>
Ineffective_Inline_Warnings := False;
when 'r' =>
Warn_On_Redundant_Constructs := True;
when 'R' =>
Warn_On_Redundant_Constructs := False;
when 's' =>
Warning_Mode := Suppress;
when 'u' =>
Check_Unreferenced := True;
Check_Withs := True;
when 'U' =>
Check_Unreferenced := False;
Check_Withs := False;
when 'w' =>
null;
when others =>
raise Bad_Switch;
end case;
Ptr := Ptr + 1;
end loop;
return;
when 'W' =>
Ptr := Ptr + 1;
for J in WC_Encoding_Method loop
if Switch_Chars (Ptr) = WC_Encoding_Letters (J) then
Wide_Character_Encoding_Method := J;
exit;
elsif J = WC_Encoding_Method'Last then
raise Bad_Switch;
end if;
end loop;
Upper_Half_Encoding :=
Wide_Character_Encoding_Method in
WC_Upper_Half_Encoding_Method;
Ptr := Ptr + 1;
when 'x' =>
Ptr := Ptr + 1;
Xref_Active := False;
when 'X' =>
Ptr := Ptr + 1;
Extensions_Allowed := True;
when 'y' =>
Ptr := Ptr + 1;
if Ptr > Max then
Set_Default_Style_Check_Options;
else
declare
OK : Boolean;
begin
Set_Style_Check_Options
(Switch_Chars (Ptr .. Max), OK, Ptr);
if not OK then
raise Bad_Switch;
end if;
end;
end if;
when 'z' =>
Ptr := Ptr + 1;
if Distribution_Stub_Mode = No_Stubs then
case Switch_Chars (Ptr) is
when 'r' =>
Distribution_Stub_Mode := Generate_Receiver_Stub_Body;
when 'c' =>
Distribution_Stub_Mode := Generate_Caller_Stub_Body;
when others =>
raise Bad_Switch;
end case;
Ptr := Ptr + 1;
end if;
when 'Z' =>
Ptr := Ptr + 1;
Zero_Cost_Exceptions_Set := True;
Zero_Cost_Exceptions_Val := True;
when '8' =>
if Ptr = Max then
raise Bad_Switch;
end if;
Ptr := Ptr + 1;
if Switch_Chars (Ptr) /= '3' then
raise Bad_Switch;
else
Ptr := Ptr + 1;
Ada_95 := False;
Ada_83 := True;
end if;
when '/' | '-' =>
Ptr := Ptr + 1;
when others =>
raise Bad_Switch;
end case;
end case;
end loop;
exception
when Bad_Switch =>
Osint.Fail ("invalid switch: ", (1 => C));
when Bad_Switch_Value =>
Osint.Fail ("numeric value too big for switch: ", (1 => C));
when Missing_Switch_Value =>
Osint.Fail ("missing numeric value for switch: ", (1 => C));
end Scan_Front_End_Switches;
procedure Scan_Make_Switches (Switch_Chars : String) is
Ptr : Integer := Switch_Chars'First;
Max : Integer := Switch_Chars'Last;
C : Character := ' ';
begin
if Ptr = Max then
raise Bad_Switch;
else
Ptr := Ptr + 1;
end if;
if Switch_Chars'Length >= Ptr + 3
and then Switch_Chars (Ptr .. Ptr + 3) = "gnat"
then
Osint.Fail
("invalid switch: """, Switch_Chars, """ (gnat not needed here)");
end if;
while Ptr <= Max loop
C := Switch_Chars (Ptr);
case C is
when 'a' =>
Ptr := Ptr + 1;
Check_Readonly_Files := True;
when 'b' =>
Ptr := Ptr + 1;
Bind_Only := True;
when 'c' =>
Ptr := Ptr + 1;
Compile_Only := True;
when 'd' =>
while Ptr < Max loop
Ptr := Ptr + 1;
C := Switch_Chars (Ptr);
exit when C = ASCII.NUL or else C = '/' or else C = '-';
if C in '1' .. '9' or else
C in 'a' .. 'z' or else
C in 'A' .. 'Z'
then
Set_Debug_Flag (C);
else
raise Bad_Switch;
end if;
end loop;
if Debug_Flag_XX then
Zero_Cost_Exceptions_Set := True;
Zero_Cost_Exceptions_Val := True;
end if;
return;
when 'f' =>
Ptr := Ptr + 1;
Force_Compilations := True;
when 'G' =>
Ptr := Ptr + 1;
Print_Generated_Code := True;
when 'h' =>
Ptr := Ptr + 1;
Usage_Requested := True;
when 'i' =>
Ptr := Ptr + 1;
In_Place_Mode := True;
when 'j' =>
Ptr := Ptr + 1;
declare
Max_Proc : Pos;
begin
Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc);
Maximum_Processes := Positive (Max_Proc);
end;
when 'k' =>
Ptr := Ptr + 1;
Keep_Going := True;
when 'l' =>
Ptr := Ptr + 1;
Link_Only := True;
when 'M' =>
Ptr := Ptr + 1;
List_Dependencies := True;
when 'n' =>
Ptr := Ptr + 1;
Do_Not_Execute := True;
when 'o' =>
Ptr := Ptr + 1;
if Output_File_Name_Present then
raise Too_Many_Output_Files;
else
Output_File_Name_Present := True;
end if;
when 'q' =>
Ptr := Ptr + 1;
Quiet_Output := True;
when 's' =>
Ptr := Ptr + 1;
Check_Switches := True;
when 'v' =>
Ptr := Ptr + 1;
Verbose_Mode := True;
when 'z' =>
Ptr := Ptr + 1;
No_Main_Subprogram := True;
when '/' | '-' =>
Ptr := Ptr + 1;
when others =>
raise Bad_Switch;
end case;
end loop;
exception
when Bad_Switch =>
Osint.Fail ("invalid switch: ", (1 => C));
when Bad_Switch_Value =>
Osint.Fail ("numeric value too big for switch: ", (1 => C));
when Missing_Switch_Value =>
Osint.Fail ("missing numeric value for switch: ", (1 => C));
when Too_Many_Output_Files =>
Osint.Fail ("duplicate -o switch");
end Scan_Make_Switches;
procedure Scan_Nat
(Switch_Chars : String;
Max : Integer;
Ptr : in out Integer;
Result : out Nat) is
begin
Result := 0;
if Ptr > Max or else Switch_Chars (Ptr) not in '0' .. '9' then
raise Missing_Switch_Value;
end if;
while Ptr <= Max and then Switch_Chars (Ptr) in '0' .. '9' loop
Result := Result * 10 +
Character'Pos (Switch_Chars (Ptr)) - Character'Pos ('0');
Ptr := Ptr + 1;
if Result > Switch_Max_Value then
raise Bad_Switch_Value;
end if;
end loop;
end Scan_Nat;
procedure Scan_Pos
(Switch_Chars : String;
Max : Integer;
Ptr : in out Integer;
Result : out Pos) is
begin
Scan_Nat (Switch_Chars, Max, Ptr, Result);
if Result = 0 then
raise Bad_Switch_Value;
end if;
end Scan_Pos;
end Switch;