MatCat.OpenSource/8sa1-gcc
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
3b56934fb9
8sa1-gcc/gcc/ada/switch.adb
Geert Bosch 17c5c8a5ee bindgen.adb: Minor reformatting 
* bindgen.adb: Minor reformatting

	* cstand.adb: Minor reformatting

	* fmap.adb: Minor reformatting
	Change name from Add for Add_To_File_Map (Add is much too generic)
	Change Path_Name_Of to Mapped_Path_Name
	Change File_Name_Of to Mapped_File_Name
	Fix copyright dates in header

	* fmap.ads:
	Change name from Add for Add_To_File_Map (Add is much too generic)
	Change Path_Name_Of to Mapped_Path_Name
	Change File_Name_Of to Mapped_File_Name
	Fix copyright dates in header

	* fname-uf.adb: Minor reformatting.  New names of stuff in Fmap.
	Add use clause for Fmap.

	* make.adb: Minor reformatting

	* osint.adb: Minor reformatting.  Change of names in Fmap.
	Add use clause for Fmap.

	* prj-env.adb: Minor reformatting

	* prj-env.ads: Minor reformatting

	* switch.adb: Minor reformatting.  Do proper raise of Bad_Switch if
	error found (there were odd exceptions to this general rule in
	-gnatec/-gnatem processing)

	* raise.c (__gnat_eh_personality): Exception handling personality
	routine for Ada.  Still in rough state, inspired from the C++ version
	and still containing a bunch of debugging artifacts.
	(parse_lsda_header, get_ttype_entry): Local (static) helpers, also
	inspired from the C++ library.

	* raise.c (eh_personality): Add comments. Part of work for the GCC 3
	exception handling integration.

	* Makefile.in: Remove use of 5smastop.adb which is obsolete.
	(HIE_SOURCES): Add s-secsta.ad{s,b}.
	(HIE_OBJS): Add s-fat*.o
	(RAVEN_SOURCES): Remove files that are no longer required. Add
	interrupt handling files.
	(RAVEN_MOD): Removed, no longer needed.

	* a-ngelfu.adb: Remove ??? comment for inappropriate Inline_Always
	Add 2001 to copyright date

	* g-regpat.adb: Change pragma Inline_Always to Inline. There is no
	need to force universal inlining for these cases.

	* s-taprob.adb: Minor clean ups so that this unit can be used in
	Ravenscar HI.

	* exp_ch7.adb: Allow use of secondary stack in HI mode.
	Disallow it when pragma Restrictions (No_Secondary_Stack) is specified.

	* prj-tree.ads (Project_Node_Record): Add comments for components
	Pkg_Id and Case_Insensitive.

	* g-socket.adb: Minor reformatting. Found while reading code.

	* prj-tree.ads: Minor reformatting

From-SVN: r48195
2001-12-20 07:22:43 +01:00

1389 lines
38 KiB
Ada
Raw Blame History

------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S W I T C H --
-- --
-- B o d y --
-- --
-- $Revision$
-- --
-- Copyright (C) 1992-2001, 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 2, 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 COPYING. If not, write --
-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
-- MA 02111-1307, USA. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
-- --
------------------------------------------------------------------------------
-- Option switch scanning for both the compiler and the binder
-- Note: this version of the package should be usable in both Unix and DOS
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;
-- Exception raised if bad switch encountered
Bad_Switch_Value : exception;
-- Exception raised if bad switch value encountered
Missing_Switch_Value : exception;
-- Exception raised if no switch value encountered
Too_Many_Output_Files : exception;
-- Exception raised if the -o switch is encountered more than once
Switch_Max_Value : constant := 999;
-- Maximum value permitted in switches that take a value
procedure Scan_Nat
(Switch_Chars : String;
Max : Integer;
Ptr : in out Integer;
Result : out Nat);
-- Scan natural integer parameter for switch. On entry, Ptr points
-- just past the switch character, on exit it points past the last
-- digit of the integer value.
procedure Scan_Pos
(Switch_Chars : String;
Max : Integer;
Ptr : in out Integer;
Result : out Pos);
-- Scan positive integer parameter for switch. On entry, Ptr points
-- just past the switch character, on exit it points past the last
-- digit of the integer value.
-------------------------
-- Is_Front_End_Switch --
-------------------------
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;
---------------
-- Is_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;
--------------------------
-- Scan_Binder_Switches --
--------------------------
procedure Scan_Binder_Switches (Switch_Chars : String) is
Ptr : Integer := Switch_Chars'First;
Max : Integer := Switch_Chars'Last;
C : Character := ' ';
begin
-- Skip past the initial character (must be the switch character)
if Ptr = Max then
raise Bad_Switch;
else
Ptr := Ptr + 1;
end if;
-- A little check, "gnat" at the start of a switch is not allowed
-- except for the compiler
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;
-- Loop to scan through switches given in switch string
while Ptr <= Max loop
C := Switch_Chars (Ptr);
case C is
-- Processing for A switch
when 'A' =>
Ptr := Ptr + 1;
Ada_Bind_File := True;
-- 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 C switch
when 'C' =>
Ptr := Ptr + 1;
Ada_Bind_File := False;
-- Processing for d switch
when 'd' =>
-- Note: for the debug switch, the remaining characters in this
-- switch field must all be debug flags, since all valid switch
-- characters are also valid debug characters.
-- Loop to scan out debug flags
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;
-- Make sure Zero_Cost_Exceptions is set if gnatdX set. This
-- is for backwards compatibility with old versions and usage.
if Debug_Flag_XX then
Zero_Cost_Exceptions_Set := True;
Zero_Cost_Exceptions_Val := True;
end if;
return;
-- Processing for e switch
when 'e' =>
Ptr := Ptr + 1;
Elab_Dependency_Output := True;
-- Processing for E switch
when 'E' =>
Ptr := Ptr + 1;
Exception_Tracebacks := True;
-- Processing for f switch
when 'f' =>
Ptr := Ptr + 1;
Force_RM_Elaboration_Order := 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;
Print_Generated_Code := True;
-- Processing for h switch
when 'h' =>
Ptr := Ptr + 1;
Usage_Requested := True;
-- Processing for i switch
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;
-- Processing for K switch
when 'K' =>
Ptr := Ptr + 1;
if Program = Binder then
Output_Linker_Option_List := True;
else
raise Bad_Switch;
end if;
-- Processing for l switch
when 'l' =>
Ptr := Ptr + 1;
Elab_Order_Output := True;
-- Processing for m switch
when 'm' =>
Ptr := Ptr + 1;
Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors);
-- 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
raise Too_Many_Output_Files;
else
Output_File_Name_Present := True;
end if;
-- Processing for O switch
when 'O' =>
Ptr := Ptr + 1;
Output_Object_List := True;
-- Processing for p switch
when 'p' =>
Ptr := Ptr + 1;
Pessimistic_Elab_Order := True;
-- Processing for q switch
when 'q' =>
Ptr := Ptr + 1;
Quiet_Output := True;
-- 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' =>
Ptr := Ptr + 1;
Time_Slice_Set := True;
Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value);
-- Processing for v switch
when 'v' =>
Ptr := Ptr + 1;
Verbose_Mode := True;
-- Processing for w switch
when 'w' =>
-- 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 's' =>
Warning_Mode := Suppress;
when others =>
raise Bad_Switch;
end case;
Ptr := Ptr + 1;
-- Processing for W switch
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;
-- Processing for x switch
when 'x' =>
Ptr := Ptr + 1;
All_Sources := False;
Check_Source_Files := False;
-- Processing for z switch
when 'z' =>
Ptr := Ptr + 1;
No_Main_Subprogram := True;
-- Ignore extra switch character
when '/' | '-' =>
Ptr := Ptr + 1;
-- Anything else is an error (illegal switch character)
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;
-----------------------------
-- Scan_Front_End_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
-- Skip past the initial character (must be the switch character)
if Ptr = Max then
raise Bad_Switch;
else
Ptr := Ptr + 1;
end if;
-- A little check, "gnat" at the start of a switch is not allowed
-- except for the compiler (where it was already removed)
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;
-- Loop to scan through switches given in switch string
while Ptr <= Max loop
C := Switch_Chars (Ptr);
-- Processing for a switch
case Switch_Starts_With_Gnat is
when False =>
-- There is only one front-end switch that
-- does not start with -gnat, namely -I
case C is
when 'I' =>
Ptr := Ptr + 1;
if Ptr > Max then
raise Bad_Switch;
end if;
-- Find out whether this is a -I- or regular -Ixxx switch
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 =>
-- Should not happen, as Scan_Switches is supposed
-- to be called for front-end switches only.
-- Still, it is safest to raise Bad_Switch error.
raise Bad_Switch;
end case;
when True =>
-- Process -gnat* options
case C is
when 'a' =>
Ptr := Ptr + 1;
Assertions_Enabled := True;
-- Processing for A switch
when 'A' =>
Ptr := Ptr + 1;
Config_File := False;
-- Processing for b switch
when 'b' =>
Ptr := Ptr + 1;
Brief_Output := True;
-- Processing for c switch
when 'c' =>
Ptr := Ptr + 1;
Operating_Mode := Check_Semantics;
-- Processing for C switch
when 'C' =>
Ptr := Ptr + 1;
Compress_Debug_Names := True;
-- Processing for d switch
when 'd' =>
-- Note: for the debug switch, the remaining characters in this
-- switch field must all be debug flags, since all valid switch
-- characters are also valid debug characters.
-- Loop to scan out debug flags
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;
-- Make sure Zero_Cost_Exceptions is set if gnatdX set. This
-- is for backwards compatibility with old versions and usage.
if Debug_Flag_XX then
Zero_Cost_Exceptions_Set := True;
Zero_Cost_Exceptions_Val := True;
end if;
return;
-- Processing for D switch
when 'D' =>
Ptr := Ptr + 1;
-- Note: -gnatD also sets -gnatx (to turn off cross-reference
-- generation in the ali file) since otherwise this generation
-- gets confused by the "wrong" Sloc values put in the tree.
Debug_Generated_Code := True;
Xref_Active := False;
Set_Debug_Flag ('g');
-- Processing for e switch
when 'e' =>
Ptr := Ptr + 1;
if Ptr > Max then
raise Bad_Switch;
end if;
case Switch_Chars (Ptr) is
-- Configuration pragmas
when 'c' =>
Ptr := Ptr + 1;
if Ptr > Max then
raise Bad_Switch;
end if;
Config_File_Name :=
new String'(Switch_Chars (Ptr .. Max));
return;
-- Mapping file
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;
-- Processing for E switch
when 'E' =>
Ptr := Ptr + 1;
Dynamic_Elaboration_Checks := True;
-- Processing for f switch
when 'f' =>
Ptr := Ptr + 1;
All_Errors_Mode := True;
-- Processing for F switch
when 'F' =>
Ptr := Ptr + 1;
External_Name_Exp_Casing := Uppercase;
External_Name_Imp_Casing := Uppercase;
-- Processing for g switch
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;
-- Processing for G switch
when 'G' =>
Ptr := Ptr + 1;
Print_Generated_Code := True;
-- Processing for h switch
when 'h' =>
Ptr := Ptr + 1;
Usage_Requested := True;
-- Processing for H switch
when 'H' =>
Ptr := Ptr + 1;
HLO_Active := True;
-- Processing for i switch
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;
-- Processing for k switch
when 'k' =>
Ptr := Ptr + 1;
Scan_Pos (Switch_Chars, Max, Ptr, Maximum_File_Name_Length);
-- Processing for l switch
when 'l' =>
Ptr := Ptr + 1;
Full_List := True;
-- Processing for L switch
when 'L' =>
Ptr := Ptr + 1;
Zero_Cost_Exceptions_Set := True;
Zero_Cost_Exceptions_Val := False;
-- Processing for m switch
when 'm' =>
Ptr := Ptr + 1;
Scan_Pos (Switch_Chars, Max, Ptr, Maximum_Errors);
-- Processing for n switch
when 'n' =>
Ptr := Ptr + 1;
Inline_Active := True;
-- Processing for N switch
when 'N' =>
Ptr := Ptr + 1;
Inline_Active := True;
Front_End_Inlining := True;
-- Processing for o switch
when 'o' =>
Ptr := Ptr + 1;
Suppress_Options.Overflow_Checks := False;
-- Processing for O switch
when 'O' =>
Ptr := Ptr + 1;
Output_File_Name_Present := True;
-- Processing for p switch
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;
-- Processing for P switch
when 'P' =>
Ptr := Ptr + 1;
Polling_Required := True;
-- Processing for q switch
when 'q' =>
Ptr := Ptr + 1;
Try_Semantics := True;
-- Processing for q switch
when 'Q' =>
Ptr := Ptr + 1;
Force_ALI_Tree_File := True;
Try_Semantics := True;
-- Processing for r switch
when 'r' =>
Ptr := Ptr + 1;
-- Temporarily allow -gnatr to mean -gnatyl (use RM layout)
-- for compatibility with pre 3.12 versions of GNAT,
-- to be removed for 3.13 ???
Set_Style_Check_Options ("l");
-- Processing for R switch
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;
-- Processing for s switch
when 's' =>
Ptr := Ptr + 1;
Operating_Mode := Check_Syntax;
-- Processing for t switch
when 't' =>
Ptr := Ptr + 1;
Tree_Output := True;
Back_Annotate_Rep_Info := True;
-- Processing for T switch
when 'T' =>
Ptr := Ptr + 1;
Time_Slice_Set := True;
Scan_Nat (Switch_Chars, Max, Ptr, Time_Slice_Value);
-- Processing for u switch
when 'u' =>
Ptr := Ptr + 1;
List_Units := True;
-- Processing for U switch
when 'U' =>
Ptr := Ptr + 1;
Unique_Error_Tag := True;
-- Processing for v switch
when 'v' =>
Ptr := Ptr + 1;
Verbose_Mode := True;
-- Processing for V switch
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;
-- Processing for w switch
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;
-- Allow and ignore 'w' so that the old
-- format (e.g. -gnatwuwl) will work.
when 'w' =>
null;
when others =>
raise Bad_Switch;
end case;
Ptr := Ptr + 1;
end loop;
return;
-- Processing for W switch
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;
-- Processing for x switch
when 'x' =>
Ptr := Ptr + 1;
Xref_Active := False;
-- Processing for X switch
when 'X' =>
Ptr := Ptr + 1;
Extensions_Allowed := True;
-- Processing for y switch
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;
-- Processing for z switch
when 'z' =>
Ptr := Ptr + 1;
-- Allowed for compiler, only if this is the only
-- -z switch, we do not allow multiple occurrences
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;
-- Processing for Z switch
when 'Z' =>
Ptr := Ptr + 1;
Zero_Cost_Exceptions_Set := True;
Zero_Cost_Exceptions_Val := True;
-- Processing for 83 switch
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;
-- Ignore extra switch character
when '/' | '-' =>
Ptr := Ptr + 1;
-- Anything else is an error (illegal switch character)
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;
------------------------
-- Scan_Make_Switches --
------------------------
procedure Scan_Make_Switches (Switch_Chars : String) is
Ptr : Integer := Switch_Chars'First;
Max : Integer := Switch_Chars'Last;
C : Character := ' ';
begin
-- Skip past the initial character (must be the switch character)
if Ptr = Max then
raise Bad_Switch;
else
Ptr := Ptr + 1;
end if;
-- A little check, "gnat" at the start of a switch is not allowed
-- except for the compiler (where it was already removed)
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;
-- Loop to scan through switches given in switch string
while Ptr <= Max loop
C := Switch_Chars (Ptr);
-- Processing for a switch
case C is
when 'a' =>
Ptr := Ptr + 1;
Check_Readonly_Files := True;
-- Processing for b switch
when 'b' =>
Ptr := Ptr + 1;
Bind_Only := True;
-- Processing for c switch
when 'c' =>
Ptr := Ptr + 1;
Compile_Only := True;
when 'd' =>
-- Note: for the debug switch, the remaining characters in this
-- switch field must all be debug flags, since all valid switch
-- characters are also valid debug characters.
-- Loop to scan out debug flags
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;
-- Make sure Zero_Cost_Exceptions is set if gnatdX set. This
-- is for backwards compatibility with old versions and usage.
if Debug_Flag_XX then
Zero_Cost_Exceptions_Set := True;
Zero_Cost_Exceptions_Val := True;
end if;
return;
-- Processing for f switch
when 'f' =>
Ptr := Ptr + 1;
Force_Compilations := True;
-- Processing for G switch
when 'G' =>
Ptr := Ptr + 1;
Print_Generated_Code := True;
-- Processing for h switch
when 'h' =>
Ptr := Ptr + 1;
Usage_Requested := True;
-- Processing for i switch
when 'i' =>
Ptr := Ptr + 1;
In_Place_Mode := True;
-- Processing for j switch
when 'j' =>
Ptr := Ptr + 1;
declare
Max_Proc : Pos;
begin
Scan_Pos (Switch_Chars, Max, Ptr, Max_Proc);
Maximum_Processes := Positive (Max_Proc);
end;
-- Processing for k switch
when 'k' =>
Ptr := Ptr + 1;
Keep_Going := True;
-- Processing for l switch
when 'l' =>
Ptr := Ptr + 1;
Link_Only := True;
when 'M' =>
Ptr := Ptr + 1;
List_Dependencies := True;
-- Processing for n switch
when 'n' =>
Ptr := Ptr + 1;
Do_Not_Execute := True;
-- Processing for o switch
when 'o' =>
Ptr := Ptr + 1;
if Output_File_Name_Present then
raise Too_Many_Output_Files;
else
Output_File_Name_Present := True;
end if;
-- Processing for q switch
when 'q' =>
Ptr := Ptr + 1;
Quiet_Output := True;
-- Processing for s switch
when 's' =>
Ptr := Ptr + 1;
Check_Switches := True;
-- Processing for v switch
when 'v' =>
Ptr := Ptr + 1;
Verbose_Mode := True;
-- Processing for z switch
when 'z' =>
Ptr := Ptr + 1;
No_Main_Subprogram := True;
-- Ignore extra switch character
when '/' | '-' =>
Ptr := Ptr + 1;
-- Anything else is an error (illegal switch character)
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;
--------------
-- Scan_Nat --
--------------
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;
--------------
-- Scan_Pos --
--------------
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;
Reference in New Issue View Git Blame Copy Permalink