8sa1-gcc/gcc/ada/switch-c.adb
Arnaud Charlet 0da2c8ac77 revert: [multiple changes]
2004-06-25  Pascal Obry  <obry@gnat.com>

	* makegpr.adb (Build_Library): Remove parameter Lib_Address and
	Relocatable from Build_Dynamic_Library call.

	* gnat_ugn.texi: Change documentation about Library_Kind. Dynamic and
	Relocatable are now synonym.

	* Makefile.in: Use s-parame-mingw.adb on MingW platform.

	* mlib-prj.adb (Build_Library): Remove DLL_Address constant definition.
	Remove parameter Lib_Address and Relocatable from Build_Dynamic_Library
	call.

	* mlib-tgt.ads, mlib-tgt.adb (Build_Dynamic_Library): Remove parameter
	Lib_Address and Relocatable.
	(Default_DLL_Address): Removed.

	* mlib-tgt-tru64.adb, mlib-tgt-aix.adb, mlib-tgt-irix.adb,
	mlib-tgt-hpux.adb, mlib-tgt-linux.adb, mlib-tgt-solaris.adb,
	mlib-tgt-vms-alpha.adb, mlib-tgt-vms-ia64.adb, mlib-tgt-vxworks.adb:
	(Build_Dynamic_Library): Remove parameter Lib_Address and Relocatable.
	(Default_DLL_Address): Removed.

	* mlib-tgt-mingw.adb: Ditto.
	(Build_Dynamic_Library): Do not add "lib" prefix to the DLL name.

	* s-taprop-mingw.adb (Create_Task): Use Adjust_Storage_Size to compute
	the initial thread stack size.

	* a-strmap.ads: Move package L to private part as it is not used in
	the spec. Found while reading code.

2004-06-25  Olivier Hainque  <hainque@act-europe.fr>

	* tracebak.c: Introduce support for a GCC infrastructure based
	implementation of __gnat_backtrace.

	* raise.c: Don't rely on a C mapping of the GNAT_GCC_Exception record
	any more. Use accessors instead. This eases maintenance and relaxes
	some alignment constraints.
	(_GNAT_Exception structure): Remove the Ada specific fields
	(EID_For, Adjust_N_Cleanups_For): New accessors, exported by
	a-exexpr.adb.
	(is_handled_by, __gnat_eh_personality): Replace component references to
	exception structure by use of the new accessors.

	* init.c (__gnat_initialize): Adjust comments to match the just
	reverted meaning of the -static link-time option.

	* adaint.c (convert_addresses): Arrange not to define a stub for
	mips-irix any more, as we now want to rely on a real version from a
	recent libaddr2line.

	* a-exexpr.adb: Provide new accessors to a GNAT_GCC occurrence, so that
	the personality routine can use them and not have to rely on a C
	counterpart of the record anymore. This simplifies maintenance and
	relaxes the constraint of having Standard'Maximum_Alignment match
	BIGGEST_ALIGNMENT.
	Update comments, and add a section on the common header alignment issue.

2004-06-25  Geert Bosch  <bosch@gnat.com>

	* a-ngelfu.adb (Tanh): Use full 20 digit precision for constants in
	polynomial approximation. Fixes inconsistency with Cody/Waite algorithm.

2004-06-25  Robert Dewar  <dewar@gnat.com>

	* gnat_rm.texi: Fix section on component clauses to indicate that the
	restriction on byte boundary placement still applies for bit packed
	arrays.
	Add comment on stack usage from Initialize_Scalars

	* gnat_ugn.texi: Add documentation for -gnatyLnnn

	* stylesw.ads, stylesw.adb: Implement new -gnatyLnnn option for
	limiting nesting level.

	* usage.adb: Add line for -gnatyLnnn switch

	* g-debpoo.ads, xtreeprs.adb, sinput.ads, sem_ch13.ads,
	sem_ch13.adb, exp_aggr.adb: Minor reformatting

	* sem_prag.adb (Process_Atomic_Shared_Volatile): Set Is_Atomic on base
	type as well as on the subtype. This corrects a problem in freeze in
	setting alignments of atomic types.

	* sem_eval.ads: Minor comment typo fixed

	* par-util.adb (Push_Scope_Stack): Check for violation of max nesting
	level.  Minor reformatting.

	* fname.adb (Is_Predefined_File_Name): Require a letter after the
	minus sign. This means that file names like a--b.adb will not be
	considered predefined.

	* freeze.adb: Propagate new flag Must_Be_On_Byte_Boundary to containing
	record Test new flag and give diagnostic for bad component clause.
	(Freeze_Entity): Set alignment of array from component alignment in
	cases where this is safe to do.

	* exp_pakd.adb: Set new flag Must_Be_On_Byte_Boundary for large packed
	arrays.

	* cstand.adb: (Create_Standard): Set alignment of String to 1

	* einfo.ads, einfo.adb: Introduce new flag Must_Be_On_Byte_Boundary

	* exp_ch4.adb (Expand_Array_Equality): Improve efficiency of generated
	code in the common constrained array cases.

	* a-storio.adb: Change implementation to avoid possible alignment
	problems on machines requiring strict alignment (data should be moved
	as type Buffer, not type Elmt).

	* checks.adb (Apply_Array_Size_Check): Improve these checks by
	killing the overflow checks which we really do not need (64-bits is
	enough).

2004-06-25  Vincent Celier  <celier@gnat.com>

	* makegpr.adb (Is_Included_In_Global_Archive): New Boolean function
	(Add_Archives.Recursive_Add_Archives): Call Add_Archive_Path
	inconditionally for the main project.
	(Recursive_Add_Archives.Add_Archive_Path): New procedure
	(Link_Executables.Check_Time_Stamps): New procedure
	(Link_Executables.Link_Foreign): New procedure
	Changes made to reduce nesting level of this package
	(Check): New procedure
	(Add_Switches): When not in quiet output, check that a switch is not
	the concatenation of several valid switches. If it is, issue a warning.
	(Build_Global_Archive): If the global archive is rebuilt, linking need
	to be done.
	(Compile_Sources): Rebuilding a library archive does not imply
	rebuilding the global archive.
	(Build_Global_Archive): New procedure
	(Build_Library): New name for Build_Archive, now only for library
	project
	(Check_Archive_Builder): New procedure
	(Create_Global_Archive_Dependency_File): New procedure
	(Gprmake): Call Build_Global_Archive before linking
	* makegpr.adb: Use Other_Sources_Present instead of Sources_Present
	throughout.
	(Scan_Arg): Display the Copyright notice when -v is used

	* gnat_ugn.texi: Document new switch -files= (VMS qualifier /FILES=)
	for gnatls.

	* vms_data.ads: Add qualifier /MAX_NESTING=nnn (-gnatyLnnn) for GNAT
	COMPILE.
	Add new GNAT LIST qualifier /FILES=
	Added qualifier /DIRECTORY= to GNAT METRIC
	Added qualifier /FILES= to GNAT METRIC
	Added qualifier /FILES to GNAT PRETTY

	* switch.adb (Is_Front_End_Switch): Refine the test for --RTS or -fRTS,
	to take into account both versions of the switch.

	* switch-c.adb (Scan_Front_End_Switches): New switch -gnatez. Should
	always be the last switch to the gcc driver. Disable switch storing so
	that switches automatically added by the gcc driver are not put in the
	ALI file.

	* prj.adb (Project_Empty): Take into account changes in components of
	Project_Data.

	* prj.ads (Languages_Processed): New enumaration value All_Languages.

	* prj.ads (Project_Data): Remove component Lib_Elaboration: never
	used. Split Boolean component Ada_Sources_Present in two Boolean
	components Ada_Sources_Present and Other_Sources_Present.
	Minor reformatting

	* prj-env.adb (For_All_Source_Dirs.Add): Use Ada_Sources_Present
	instead of Sources_Present.
	(Set_Ada_Paths.Add.Recursive_Add): Ditto

	* prj-nmsc.adb: Minor reformatting
	(Check_Ada_Naming_Scheme): New name of procedure Check_Naming_Scheme
	(Check_Ada_Naming_Scheme_Validity): New name of previous procedure
	Check_Ada_Naming_Scheme.
	Change Sources_Present to Ada_Sources_Present or Other_Sources_Present
	throughout.

	* prj-part.adb (Post_Parse_Context_Clause): New Boolean parameter
	In_Limited.
	Make sure that all cycles where there is at least one "limited with"
	are detected.
	(Parse_Single_Project): New Boolean parameter In_Limited

	* prj-proc.adb (Recursive_Check): When Process_Languages is
	All_Languages, call first Prj.Nmsc.Ada_Check, then
	Prj.Nmsc.Other_Languages_Check.

	* prj-proc.adb (Process): Use Ada_Sources_Present or
	Other_Sources_Present (instead of Sources_Present) depending on
	Process_Languages.

	* lang-specs.h: Keep -g and -m switches in the same order, and as the
	last switches.

	* lib.adb (Switch_Storing_Enabled): New global Boolean flag
	(Disable_Switch_Storing): New procedure. Set Switch_Storing_Enabled to
	False.
	(Store_Compilation_Switch): Do nothing if Switch_Storing_Enabled is
	False.

	* lib.ads (Disable_Switch_Storing): New procedure.

	* make.adb: Modifications to reduce nesting level of this package.
	(Check_Standard_Library): New procedure
	(Gnatmake.Check_Mains): New procedure
	(Gnatmake.Create_Binder_Mapping_File): New procedure
	(Compile_Sources.Compile): Add switch -gnatez as the last option
	(Display): Never display -gnatez

	* Makefile.generic:
	When using $(MAIN_OBJECT), always use $(OBJ_DIR)/$(MAIN_OBJECT)

	* gnatcmd.adb (Check_Project): New function
	(Process_Link): New procedure to reduce nesting depth
	(Check_Files): New procedure to reduce the nesting depth.
	For GNAT METRIC, include the inherited sources in extending projects.
	(GNATCmd): When GNAT LS is invoked with a project file and no files,
	add the list of files from the sources of the project file. If this list
	is too long, put it in a temp text files and use switch -files=
	(Delete_Temp_Config_Files): Delete the temp text file that contains
	a list of source for gnatpp or gnatmetric, if one has been created.
	(GNATCmd): For GNAT METRIC and GNAT PRETTY, if the number of sources
	in the project file is too large, create a temporary text file that
	list them and pass it to the tool with "-files=<temp text file>".
	(GNATCmd): For GNAT METRIC add "-d=<abject dir>" as the first switch

	* gnatlink.adb (Gnatlink): Do not compile with --RTS= when the
	generated file is in not in Ada.

	* gnatls.adb: Remove all parameters And_Save that are no longer used.
	(Scan_Ls_Arg): Add processing for -files=
	(Usage): Add line for -files=

	* g-os_lib.adb (On_Windows): New global constant Boolean flag
	(Normalize_Pathname): When on Windows and the path starts with a
	directory separator, make sure that the resulting path will start with
	a drive letter.

	* clean.adb (Clean_Archive): New procedure
	(Clean_Project): When there is non-Ada code, delete the global archive,
	the archive dependency files, the object files and their dependency
	files, if they exist.
	(Gnatclean): Call Prj.Pars.Parse for All_Languages, not for Ada only.

2004-06-25  Thomas Quinot  <quinot@act-europe.fr>

	* sinfo.ads: Fix typo in comment.

	* sem_dist.adb (Process_Remote_AST_Attribute): Simplify code that uses
	the TSS for remote access-to-subprogram types, since these TSS are
	always present once the type has been analyzed.
	(RAS_E_Dereference): Same.

	* sem_attr.adb (Analyze_Attribute): When analysis of an attribute
	reference raises Bad_Attribute, mark the reference as analyzed so the
	node (and any children resulting from rewrites that could have occurred
	during the analysis that ultimately failed) is not analyzed again.

	* exp_ch7.ads (Find_Final_List): Fix misaligned comment.

	* exp_dist.adb: Minor comment fix.

	* exp_ch4.adb (Expand_N_Allocator): For an allocator whose expected
	type is an anonymous access type, no unchecked deallocation of the
	allocated object can occur. If the object is controlled, attach it with
	a count of 1. This allows attachment to the Global_Final_List, if
	no other relevant list is available.
	(Get_Allocator_Final_List): For an anonymous access type that is
	the type of a discriminant or record component, the corresponding
	finalisation list is the one of the scope of the type.

2004-06-25  Ed Schonberg  <schonberg@gnat.com>

	* sem_ch3.adb (Replace_Type): When computing the signature of an
	inherited subprogram, use the first subtype if the derived type
	declaration has no constraint.

	* exp_ch6.adb (Add_Call_By_Copy_Code): Check that formal is an array
	before applying previous optimization. Minor code cleanup.

	* exp_util.adb (Is_Possibly_Unaligned_Slice): If the component is
	placed at the beginning of an unpacked record without explicit
	alignment, a slice of it will be aligned and does not need a copy when
	used as an actual.

2004-06-25  Ed Schonberg  <schonberg@gnat.com>

	PR ada/15591
	PR ada/15592
	* sem_ch8.adb (Attribute_Renaming): Reject renaming if the attribute
	reference is written with expressions mimicking parameters.

2004-06-25  Hristian Kirtchev  <kirtchev@gnat.com>

	PR ada/15589
	* sem_ch3.adb (Build_Derived_Record_Type): Add additional check to
	STEP 2a. The constraints of a full type declaration of a derived record
	type are checked for conformance with those declared in the
	corresponding private extension declaration. The message
	"not conformant with previous declaration" is emitted if an error is
	detected.

2004-06-25  Vasiliy Fofanov  <fofanov@act-europe.fr>

	* g-traceb.ads: Document the need for -E binder switch in the spec.

	* g-trasym.ads: Document the need for -E binder switch in the spec.

2004-06-25  Jose Ruiz  <ruiz@act-europe.fr>

	* sem_prag.adb: Add handling of pragma Detect_Blocking.

	* snames.h, snames.ads, snames.adb: Add entry for pragma
	Detect_Blocking.

	* s-rident.ads: Change reference to pragma Detect_Blocking.

	* targparm.ads, targparm.adb: Allow pragma Detect_Blocking in
	system.ads.

	* opt.ads (Detect_Blocking): New Boolean variable (defaulted to False)
	to indicate whether pragma Detect_Blocking is active.

	* par-prag.adb: Add entry for pragma Detect_Blocking.

	* rtsfind.adb (RTU_Loaded): Fix the temporary kludge to get past bug
	of not handling WITH.
	Note that this replaces the previous update which was incorrect.

2004-06-25  Javier Miranda  <miranda@gnat.com>

	* sem_ch10.adb (Re_Install_Use_Clauses): Force the installation of the
	use-clauses to have a clean environment.

	* sem_ch8.adb (Install_Use_Clauses): Addition of a new formal to force
	the installation of the use-clauses to stablish a clean environment in
	case of compilation of a separate unit; otherwise the call to
	use_one_package is protected by the barrier Applicable_Use.

	* sem_ch8.ads (Install_Use_Clauses): Addition of a new formal to force
	the installation of the use-clauses to stablish a clean environment in
	case of compilation of a separate unit.
	(End_Use_Clauses): Minor comment cleanup.

2004-06-25  Sergey Rybin  <rybin@act-europe.fr>

	* gnat_ugn.texi: Add description of the gnatpp 'files' switch

From-SVN: r83658
2004-06-25 18:39:33 +02:00

1130 lines
36 KiB
Ada

------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S W I T C H - C --
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2004 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. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with GNAT.OS_Lib; use GNAT.OS_Lib;
with Debug; use Debug;
with Lib; use Lib;
with Osint; use Osint;
with Opt; use Opt;
with Prepcomp; use Prepcomp;
with Types; use Types;
with Validsw; use Validsw;
with Stylesw; use Stylesw;
with System.WCh_Con; use System.WCh_Con;
package body Switch.C is
RTS_Specified : String_Access := null;
-- Used to detect multiple use of --RTS= flag
-----------------------------
-- Scan_Front_End_Switches --
-----------------------------
procedure Scan_Front_End_Switches (Switch_Chars : String) is
Switch_Starts_With_Gnat : Boolean;
-- True if first four switch characters are "gnat"
First_Switch : Boolean := True;
-- False for all but first switch
Ptr : Integer := Switch_Chars'First;
Max : constant Integer := Switch_Chars'Last;
C : Character := ' ';
Dot : Boolean;
Store_Switch : Boolean := True;
First_Char : Integer := Ptr;
Storing : String := Switch_Chars;
First_Stored : Positive := Ptr + 1;
-- The above need comments ???
begin
-- Skip past the initial character (must be the switch character)
if Ptr = Max then
raise Bad_Switch;
else
Ptr := Ptr + 1;
end if;
-- Remove "gnat" from the switch, if present
Switch_Starts_With_Gnat :=
Ptr + 3 <= Max and then Switch_Chars (Ptr .. Ptr + 3) = "gnat";
if Switch_Starts_With_Gnat then
Ptr := Ptr + 4;
First_Stored := Ptr;
end if;
-- Loop to scan through switches given in switch string
while Ptr <= Max loop
Store_Switch := True;
First_Char := Ptr;
C := Switch_Chars (Ptr);
-- Processing for a switch
case Switch_Starts_With_Gnat is
when False =>
-- There are few front-end switches that
-- do not start with -gnat: -I, --RTS
if Switch_Chars (Ptr) = 'I' then
Store_Switch := False;
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;
-- Processing of the --RTS switch. --RTS has been modified by
-- gcc and is now of the form -fRTS
elsif Ptr + 3 <= Max
and then Switch_Chars (Ptr .. Ptr + 3) = "fRTS"
then
Ptr := Ptr + 1;
if Ptr + 4 > Max
or else Switch_Chars (Ptr + 3) /= '='
then
Osint.Fail ("missing path for --RTS");
else
-- Check that this is the first time --RTS is specified
-- or if it is not the first time, the same path has
-- been specified.
if RTS_Specified = null then
RTS_Specified :=
new String'(Switch_Chars (Ptr + 4 .. Max));
elsif
RTS_Specified.all /= Switch_Chars (Ptr + 4 .. Max)
then
Osint.Fail
("--RTS cannot be specified multiple times");
end if;
-- Valid --RTS switch
Opt.No_Stdinc := True;
Opt.RTS_Switch := True;
RTS_Src_Path_Name := Get_RTS_Search_Dir
(Switch_Chars (Ptr + 4 .. Max),
Include);
RTS_Lib_Path_Name := Get_RTS_Search_Dir
(Switch_Chars (Ptr + 4 .. Max),
Objects);
if RTS_Src_Path_Name /= null and then
RTS_Lib_Path_Name /= null
then
Ptr := Max + 1;
elsif RTS_Src_Path_Name = null and then
RTS_Lib_Path_Name = null
then
Osint.Fail ("RTS path not valid: missing " &
"adainclude and adalib directories");
elsif RTS_Src_Path_Name = null then
Osint.Fail ("RTS path not valid: missing " &
"adainclude directory");
elsif RTS_Lib_Path_Name = null then
Osint.Fail ("RTS path not valid: missing " &
"adalib directory");
end if;
end if;
else
raise Bad_Switch;
end if;
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' =>
if not First_Switch then
Osint.Fail
("-gnatc must be first if combined with other switches");
end if;
Ptr := Ptr + 1;
Operating_Mode := Check_Semantics;
if Tree_Output then
ASIS_Mode := True;
end if;
-- Processing for d switch
when 'd' =>
Store_Switch := False;
Storing (First_Stored) := 'd';
Dot := False;
-- 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
if Dot then
Set_Dotted_Debug_Flag (C);
Storing (First_Stored + 1) := '.';
Storing (First_Stored + 2) := C;
Store_Compilation_Switch
(Storing (Storing'First .. First_Stored + 2));
Dot := False;
else
Set_Debug_Flag (C);
Storing (First_Stored + 1) := C;
Store_Compilation_Switch
(Storing (Storing'First .. First_Stored + 1));
end if;
elsif C = '.' then
Dot := True;
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');
-- -gnate? (extended switches)
when 'e' =>
Ptr := Ptr + 1;
-- The -gnate? switches are all double character switches
-- so we must always have a character after the e.
if Ptr > Max then
raise Bad_Switch;
end if;
case Switch_Chars (Ptr) is
-- -gnatec (configuration pragmas)
when 'c' =>
Store_Switch := False;
Ptr := Ptr + 1;
-- There may be an equal sign between -gnatec and
-- the path name of the config file.
if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
Ptr := Ptr + 1;
end if;
if Ptr > Max then
raise Bad_Switch;
end if;
declare
Config_File_Name : constant String_Access :=
new String'
(Switch_Chars (Ptr .. Max));
begin
if Config_File_Names = null then
Config_File_Names :=
new String_List'(1 => Config_File_Name);
else
declare
New_Names : constant String_List_Access :=
new String_List
(1 ..
Config_File_Names'Length + 1);
begin
for Index in Config_File_Names'Range loop
New_Names (Index) :=
Config_File_Names (Index);
Config_File_Names (Index) := null;
end loop;
New_Names (New_Names'Last) := Config_File_Name;
Free (Config_File_Names);
Config_File_Names := New_Names;
end;
end if;
end;
return;
-- -gnateD switch (symbol definition)
when 'D' =>
Store_Switch := False;
Ptr := Ptr + 1;
if Ptr > Max then
raise Bad_Switch;
end if;
Add_Symbol_Definition (Switch_Chars (Ptr .. Max));
-- Store the switch
Storing (First_Stored .. First_Stored + 1) := "eD";
Storing
(First_Stored + 2 .. First_Stored + Max - Ptr + 2) :=
Switch_Chars (Ptr .. Max);
Store_Compilation_Switch (Storing
(Storing'First .. First_Stored + Max - Ptr + 2));
return;
-- -gnatef (full source path for brief error messages)
when 'f' =>
Store_Switch := False;
Ptr := Ptr + 1;
Full_Path_Name_For_Brief_Errors := True;
return;
-- -gnateI (index of unit in multi-unit source)
when 'I' =>
Ptr := Ptr + 1;
Scan_Pos (Switch_Chars, Max, Ptr, Multiple_Unit_Index);
-- -gnatem (mapping file)
when 'm' =>
Store_Switch := False;
Ptr := Ptr + 1;
-- There may be an equal sign between -gnatem and
-- the path name of the mapping file.
if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
Ptr := Ptr + 1;
end if;
if Ptr > Max then
raise Bad_Switch;
end if;
Mapping_File_Name :=
new String'(Switch_Chars (Ptr .. Max));
return;
-- -gnatep (preprocessing data file)
when 'p' =>
Store_Switch := False;
Ptr := Ptr + 1;
-- There may be an equal sign between -gnatep and
-- the path name of the mapping file.
if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
Ptr := Ptr + 1;
end if;
if Ptr > Max then
raise Bad_Switch;
end if;
Preprocessing_Data_File :=
new String'(Switch_Chars (Ptr .. Max));
-- Store the switch.
-- Because we may store a longer switch (we normalize
-- to -gnatep=), use a local variable.
declare
To_Store : String
(1 .. Preprocessing_Data_File'Length + 8);
begin
To_Store (1 .. 8) := "-gnatep=";
To_Store (9 .. Preprocessing_Data_File'Length + 8) :=
Preprocessing_Data_File.all;
Store_Compilation_Switch (To_Store);
end;
return;
when 'z' =>
Store_Switch := False;
Disable_Switch_Storing;
Ptr := Ptr + 1;
-- All other -gnate? switches are unassigned
when others =>
raise Bad_Switch;
end case;
-- -gnatE (dynamic elaboration checks)
when 'E' =>
Ptr := Ptr + 1;
Dynamic_Elaboration_Checks := True;
-- -gnatf (full error messages)
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';
System_Extend_Unit := Empty;
Warning_Mode := Treat_As_Error;
-- Set default warnings (basically -gnatwa)
Check_Unreferenced := True;
Check_Unreferenced_Formals := True;
Check_Withs := True;
Constant_Condition_Warnings := True;
Implementation_Unit_Warnings := True;
Ineffective_Inline_Warnings := True;
Warn_On_Constant := True;
Warn_On_Export_Import := True;
Warn_On_Modified_Unread := True;
Warn_On_No_Value_Assigned := True;
Warn_On_Obsolescent_Feature := True;
Warn_On_Redundant_Constructs := True;
Warn_On_Unchecked_Conversion := True;
Warn_On_Unrecognized_Pragma := 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 = '9'
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_Check) := False;
Opt.Enable_Overflow_Checks := True;
-- Processing for O switch
when 'O' =>
Store_Switch := False;
Ptr := Ptr + 1;
Output_File_Name_Present := True;
-- Processing for p switch
when 'p' =>
Ptr := Ptr + 1;
Suppress_Options := (others => True);
Validity_Checks_On := False;
Opt.Suppress_Checks := True;
Opt.Enable_Overflow_Checks := 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;
Back_Annotate_Rep_Info := True;
List_Representation_Info := 1;
while Ptr <= Max loop
C := Switch_Chars (Ptr);
if C in '1' .. '3' then
List_Representation_Info :=
Character'Pos (C) - Character'Pos ('0');
elsif Switch_Chars (Ptr) = 's' then
List_Representation_Info_To_File := True;
elsif Switch_Chars (Ptr) = 'm' then
List_Representation_Info_Mechanisms := True;
else
raise Bad_Switch;
end if;
Ptr := Ptr + 1;
end loop;
-- Processing for s switch
when 's' =>
if not First_Switch then
Osint.Fail
("-gnats must be first if combined with other switches");
end if;
Ptr := Ptr + 1;
Operating_Mode := Check_Syntax;
-- Processing for S switch
when 'S' =>
Print_Standard := True;
Ptr := Ptr + 1;
-- Processing for t switch
when 't' =>
Ptr := Ptr + 1;
Tree_Output := True;
if Operating_Mode = Check_Semantics then
ASIS_Mode := True;
end if;
Back_Annotate_Rep_Info := True;
-- Processing for T switch
when 'T' =>
Ptr := Ptr + 1;
Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor);
-- 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' =>
Store_Switch := False;
Storing (First_Stored) := '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;
for Index in First_Char + 1 .. Max loop
Storing (First_Stored + 1) :=
Switch_Chars (Index);
Store_Compilation_Switch
(Storing (Storing'First .. First_Stored + 1));
end loop;
end;
end if;
Ptr := Max + 1;
-- Processing for w switch
when 'w' =>
Store_Switch := False;
Storing (First_Stored) := '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' =>
Check_Unreferenced := True;
Check_Unreferenced_Formals := True;
Check_Withs := True;
Constant_Condition_Warnings := True;
Implementation_Unit_Warnings := True;
Ineffective_Inline_Warnings := True;
Warn_On_Constant := True;
Warn_On_Export_Import := True;
Warn_On_Modified_Unread := True;
Warn_On_No_Value_Assigned := True;
Warn_On_Obsolescent_Feature := True;
Warn_On_Redundant_Constructs := True;
Warn_On_Unchecked_Conversion := True;
Warn_On_Unrecognized_Pragma := True;
when 'A' =>
Check_Unreferenced := False;
Check_Unreferenced_Formals := False;
Check_Withs := False;
Constant_Condition_Warnings := False;
Elab_Warnings := False;
Implementation_Unit_Warnings := False;
Ineffective_Inline_Warnings := False;
Warn_On_Constant := False;
Warn_On_Dereference := False;
Warn_On_Export_Import := False;
Warn_On_Hiding := False;
Warn_On_Modified_Unread := False;
Warn_On_No_Value_Assigned := False;
Warn_On_Obsolescent_Feature := False;
Warn_On_Redundant_Constructs := False;
Warn_On_Unchecked_Conversion := False;
Warn_On_Unrecognized_Pragma := False;
when 'c' =>
Constant_Condition_Warnings := True;
when 'C' =>
Constant_Condition_Warnings := False;
when 'd' =>
Warn_On_Dereference := True;
when 'D' =>
Warn_On_Dereference := False;
when 'e' =>
Warning_Mode := Treat_As_Error;
when 'f' =>
Check_Unreferenced_Formals := True;
when 'F' =>
Check_Unreferenced_Formals := False;
when 'g' =>
Warn_On_Unrecognized_Pragma := True;
when 'G' =>
Warn_On_Unrecognized_Pragma := False;
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 'j' =>
Warn_On_Obsolescent_Feature := True;
when 'J' =>
Warn_On_Obsolescent_Feature := False;
when 'k' =>
Warn_On_Constant := True;
when 'K' =>
Warn_On_Constant := False;
when 'l' =>
Elab_Warnings := True;
when 'L' =>
Elab_Warnings := False;
when 'm' =>
Warn_On_Modified_Unread := True;
when 'M' =>
Warn_On_Modified_Unread := False;
when 'n' =>
Warning_Mode := Normal;
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;
Check_Unreferenced_Formals := True;
when 'U' =>
Check_Unreferenced := False;
Check_Withs := False;
Check_Unreferenced_Formals := False;
when 'v' =>
Warn_On_No_Value_Assigned := True;
when 'V' =>
Warn_On_No_Value_Assigned := False;
when 'x' =>
Warn_On_Export_Import := True;
when 'X' =>
Warn_On_Export_Import := False;
when 'z' =>
Warn_On_Unchecked_Conversion := True;
when 'Z' =>
Warn_On_Unchecked_Conversion := 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;
if C /= 'w' then
Storing (First_Stored + 1) := C;
Store_Compilation_Switch
(Storing (Storing'First .. First_Stored + 1));
end if;
Ptr := Ptr + 1;
end loop;
return;
-- Processing for W switch
when 'W' =>
Ptr := Ptr + 1;
if Ptr > Max then
raise Bad_Switch;
end if;
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;
Ada_Version := Ada_Version_Type'Last;
-- Processing for y switch
when 'y' =>
Ptr := Ptr + 1;
if Ptr > Max then
Set_Default_Style_Check_Options;
else
Store_Switch := False;
Storing (First_Stored) := 'y';
declare
OK : Boolean;
Last_Stored : Integer;
begin
Set_Style_Check_Options
(Switch_Chars (Ptr .. Max), OK, Ptr);
if not OK then
raise Bad_Switch;
end if;
Ptr := First_Char + 1;
while Ptr <= Max loop
Last_Stored := First_Stored + 1;
Storing (Last_Stored) := Switch_Chars (Ptr);
if Switch_Chars (Ptr) = 'M' then
loop
Ptr := Ptr + 1;
exit when Ptr > Max
or else Switch_Chars (Ptr) not in '0' .. '9';
Last_Stored := Last_Stored + 1;
Storing (Last_Stored) := Switch_Chars (Ptr);
end loop;
else
Ptr := Ptr + 1;
end if;
Store_Compilation_Switch
(Storing (Storing'First .. Last_Stored));
end loop;
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_Version := Ada_83;
end if;
-- Processing for 95 switch
when '9' =>
if Ptr = Max then
raise Bad_Switch;
end if;
Ptr := Ptr + 1;
if Switch_Chars (Ptr) /= '5' then
raise Bad_Switch;
else
Ptr := Ptr + 1;
Ada_Version := Ada_95;
end if;
-- Processing for 05 switch
when '0' =>
if Ptr = Max then
raise Bad_Switch;
end if;
Ptr := Ptr + 1;
if Switch_Chars (Ptr) /= '5' then
raise Bad_Switch;
else
Ptr := Ptr + 1;
Ada_Version := Ada_05;
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;
if Store_Switch then
Storing (First_Stored .. First_Stored + Ptr - First_Char - 1) :=
Switch_Chars (First_Char .. Ptr - 1);
Store_Compilation_Switch
(Storing (Storing'First .. First_Stored + Ptr - First_Char - 1));
end if;
First_Switch := False;
end loop;
exception
when Bad_Switch =>
Osint.Fail ("invalid switch: ", (1 => C));
when Bad_Switch_Value =>
Osint.Fail ("numeric value out of range for switch: ", (1 => C));
when Missing_Switch_Value =>
Osint.Fail ("missing numeric value for switch: ", (1 => C));
end Scan_Front_End_Switches;
end Switch.C;