* 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
1389 lines
38 KiB
Ada
1389 lines
38 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- 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;
|