blob: 5af71c62fbb55728852df1418c8143a9c4f0dcae [file] [log] [blame]
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- S W I T C H - C --
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2019, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
-- This package is for switch processing and should not depend on higher level
-- packages such as those for the scanner, parser, etc. Doing so may cause
-- circularities, especially for back ends using Adabkend.
with Debug; use Debug;
with Errout; use Errout;
with Lib; use Lib;
with Osint; use Osint;
with Opt; use Opt;
with Stylesw; use Stylesw;
with Targparm; use Targparm;
with Ttypes; use Ttypes;
with Validsw; use Validsw;
with Warnsw; use Warnsw;
with Ada.Unchecked_Deallocation;
with System.WCh_Con; use System.WCh_Con;
with System.OS_Lib;
package body Switch.C is
RTS_Specified : String_Access := null;
-- Used to detect multiple use of --RTS= flag
procedure Add_Symbol_Definition (Def : String);
-- Add a symbol definition from the command line
procedure Free is
new Ada.Unchecked_Deallocation (String_List, String_List_Access);
-- Avoid using System.Strings.Free, which also frees the designated strings
function Get_Overflow_Mode (C : Character) return Overflow_Mode_Type;
-- Given a digit in the range 0 .. 3, returns the corresponding value of
-- Overflow_Mode_Type. Raises Program_Error if C is outside this range.
function Switch_Subsequently_Cancelled
(C : String;
Args : String_List;
Arg_Rank : Positive) return Boolean;
-- This function is called from Scan_Front_End_Switches. It determines if
-- the switch currently being scanned is followed by a switch of the form
-- "-gnat-" & C, where C is the argument. If so, then True is returned,
-- and Scan_Front_End_Switches will cancel the effect of the switch. If
-- no such switch is found, False is returned.
---------------------------
-- Add_Symbol_Definition --
---------------------------
procedure Add_Symbol_Definition (Def : String) is
begin
-- If Preprocessor_Symbol_Defs is not large enough, double its size
if Preprocessing_Symbol_Last = Preprocessing_Symbol_Defs'Last then
declare
New_Symbol_Definitions : constant String_List_Access :=
new String_List (1 .. 2 * Preprocessing_Symbol_Last);
begin
New_Symbol_Definitions (Preprocessing_Symbol_Defs'Range) :=
Preprocessing_Symbol_Defs.all;
Free (Preprocessing_Symbol_Defs);
Preprocessing_Symbol_Defs := New_Symbol_Definitions;
end;
end if;
Preprocessing_Symbol_Last := Preprocessing_Symbol_Last + 1;
Preprocessing_Symbol_Defs (Preprocessing_Symbol_Last) :=
new String'(Def);
end Add_Symbol_Definition;
-----------------------
-- Get_Overflow_Mode --
-----------------------
function Get_Overflow_Mode (C : Character) return Overflow_Mode_Type is
begin
case C is
when '1' =>
return Strict;
when '2' =>
return Minimized;
-- Eliminated allowed only if Long_Long_Integer is 64 bits (since
-- the current implementation of System.Bignums assumes this).
when '3' =>
if Standard_Long_Long_Integer_Size /= 64 then
Bad_Switch ("-gnato3 not implemented for this configuration");
else
return Eliminated;
end if;
when others =>
raise Program_Error;
end case;
end Get_Overflow_Mode;
-----------------------------
-- Scan_Front_End_Switches --
-----------------------------
procedure Scan_Front_End_Switches
(Switch_Chars : String;
Args : String_List;
Arg_Rank : Positive)
is
Max : constant Natural := Switch_Chars'Last;
C : Character := ' ';
Ptr : Natural;
Dot : Boolean;
-- This flag is set upon encountering a dot in a debug switch
First_Char : Positive;
-- Marks start of switch to be stored
First_Ptr : Positive;
-- Save position of first character after -gnatd (for checking that
-- debug flags that must come first are first, in particular -gnatd.b).
First_Switch : Boolean := True;
-- False for all but first switch
Store_Switch : Boolean;
-- For -gnatxx switches, the normal processing, signalled by this flag
-- being set to True, is to store the switch on exit from the case
-- statement, the switch stored is -gnat followed by the characters
-- from First_Char to Ptr-1. For cases like -gnaty, where the switch
-- is stored in separate pieces, this flag is set to False, and the
-- appropriate calls to Store_Compilation_Switch are made from within
-- the case branch.
Underscore : Boolean;
-- This flag is set upon encountering an underscode in a debug switch
begin
Ptr := Switch_Chars'First;
-- Skip past the initial character (must be the switch character)
if Ptr = Max then
Bad_Switch (C);
else
Ptr := Ptr + 1;
end if;
-- Handle switches that do not start with -gnat
if Ptr + 3 > Max or else Switch_Chars (Ptr .. Ptr + 3) /= "gnat" then
-- There are two front-end switches that do not start with -gnat:
-- -I, --RTS
if Switch_Chars (Ptr) = 'I' then
-- Set flag Search_Directory_Present if switch is "-I" only:
-- the directory will be the next argument.
if Ptr = Max then
Search_Directory_Present := True;
return;
end if;
Ptr := Ptr + 1;
-- Find out whether this is a -I- or regular -Ixxx switch
-- Note: -I switches are not recorded in the ALI file, since the
-- meaning of the program depends on the source files compiled,
-- not where they came from.
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;
-- Processing of the --RTS switch. --RTS may have been modified by
-- gcc into -fRTS (for GCC targets).
elsif Ptr + 3 <= Max
and then (Switch_Chars (Ptr .. Ptr + 3) = "fRTS"
or else
Switch_Chars (Ptr .. Ptr + 3) = "-RTS")
then
Ptr := Ptr + 1;
if Ptr + 4 > Max
or else Switch_Chars (Ptr + 3) /= '='
then
Osint.Fail ("missing path for --RTS");
else
declare
Runtime_Dir : String_Access;
begin
if System.OS_Lib.Is_Absolute_Path
(Switch_Chars (Ptr + 4 .. Max))
then
Runtime_Dir :=
new String'(System.OS_Lib.Normalize_Pathname
(Switch_Chars (Ptr + 4 .. Max)));
else
Runtime_Dir :=
new String'(Switch_Chars (Ptr + 4 .. Max));
end if;
-- Valid --RTS switch
Opt.No_Stdinc := True;
Opt.RTS_Switch := True;
RTS_Src_Path_Name :=
Get_RTS_Search_Dir (Runtime_Dir.all, Include);
RTS_Lib_Path_Name :=
Get_RTS_Search_Dir (Runtime_Dir.all, Objects);
if RTS_Specified /= null then
if RTS_Src_Path_Name = null
or else RTS_Lib_Path_Name = null
or else
System.OS_Lib.Normalize_Pathname
(RTS_Specified.all) /=
System.OS_Lib.Normalize_Pathname
(RTS_Lib_Path_Name.all)
then
Osint.Fail
("--RTS cannot be specified multiple times");
end if;
elsif RTS_Src_Path_Name /= null
and then RTS_Lib_Path_Name /= null
then
-- Store the -fRTS switch (Note: Store_Compilation_Switch
-- changes -fRTS back into --RTS for the actual output).
Store_Compilation_Switch (Switch_Chars);
RTS_Specified := new String'(RTS_Lib_Path_Name.all);
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;
end if;
-- There are no other switches not starting with -gnat
else
Bad_Switch (Switch_Chars);
end if;
-- Case of switch starting with -gnat
else
Ptr := Ptr + 4;
-- Loop to scan through switches given in switch string
while Ptr <= Max loop
First_Char := Ptr;
Store_Switch := True;
C := Switch_Chars (Ptr);
case C is
-- -gnata (assertions enabled)
when 'a' =>
Ptr := Ptr + 1;
Assertions_Enabled := True;
-- -gnatA (disregard gnat.adc)
when 'A' =>
Ptr := Ptr + 1;
Config_File := False;
-- -gnatb (brief messages to stderr)
when 'b' =>
Ptr := Ptr + 1;
Brief_Output := True;
-- -gnatB (assume no invalid values)
when 'B' =>
Ptr := Ptr + 1;
Assume_No_Invalid_Values := True;
-- -gnatc (check syntax and semantics only)
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;
-- -gnatC (Generate CodePeer information)
when 'C' =>
Ptr := Ptr + 1;
CodePeer_Mode := True;
-- -gnatd (compiler debug options)
when 'd' =>
Dot := False;
Store_Switch := False;
Underscore := False;
First_Ptr := Ptr + 1;
-- 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
-- Case of dotted flag
if Dot then
Set_Dotted_Debug_Flag (C);
Store_Compilation_Switch ("-gnatd." & C);
-- Special check, -gnatd.b must come first
if C = 'b'
and then (Ptr /= First_Ptr + 1
or else not First_Switch)
then
Osint.Fail
("-gnatd.b must be first if combined with other "
& "switches");
end if;
-- Case of an underscored flag
elsif Underscore then
Set_Underscored_Debug_Flag (C);
Store_Compilation_Switch ("-gnatd_" & C);
-- Normal flag
else
Set_Debug_Flag (C);
Store_Compilation_Switch ("-gnatd" & C);
end if;
elsif C = '.' then
Dot := True;
elsif C = '_' then
Underscore := True;
elsif Dot then
Bad_Switch ("-gnatd." & Switch_Chars (Ptr .. Max));
elsif Underscore then
Bad_Switch ("-gnatd_" & Switch_Chars (Ptr .. Max));
else
Bad_Switch ("-gnatd" & Switch_Chars (Ptr .. Max));
end if;
end loop;
return;
-- -gnatD (debug expanded code)
when 'D' =>
Ptr := Ptr + 1;
-- Not allowed if previous -gnatR given
-- The reason for this prohibition is that the rewriting of
-- Sloc values causes strange malfunctions in the tests of
-- whether units belong to the main source. This is really a
-- bug, but too hard to fix for a marginal capability ???
-- The proper fix is to completely redo -gnatD processing so
-- that the tree is not messed with, and instead a separate
-- table is built on the side for debug information generation.
if List_Representation_Info /= 0 then
Osint.Fail
("-gnatD not permitted since -gnatR given previously");
end if;
-- Scan optional integer line limit value
if Nat_Present (Switch_Chars, Max, Ptr) then
Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'D');
Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
end if;
-- 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
Bad_Switch ("-gnate");
end if;
case Switch_Chars (Ptr) is
-- -gnatea (initial delimiter of explicit switches)
-- This is an internal switch
-- All switches that come before -gnatea have been added by
-- the GCC driver and are not stored in the ALI file.
-- See also -gnatez below.
when 'a' =>
Store_Switch := False;
Enable_Switch_Storing;
Ptr := Ptr + 1;
-- -gnateA (aliasing checks on parameters)
when 'A' =>
Ptr := Ptr + 1;
Check_Aliasing_Of_Parameters := True;
-- -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
Bad_Switch ("-gnatec");
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;
-- -gnateC switch (generate CodePeer messages)
when 'C' =>
Ptr := Ptr + 1;
if not Generate_CodePeer_Messages then
Generate_CodePeer_Messages := True;
CodePeer_Mode := True;
Warning_Mode := Normal;
Warning_Doc_Switch := True; -- -gnatw.d
-- Enable warnings potentially useful for non GNAT
-- users.
Constant_Condition_Warnings := True; -- -gnatwc
Warn_On_Assertion_Failure := True; -- -gnatw.a
Warn_On_Assumed_Low_Bound := True; -- -gnatww
Warn_On_Bad_Fixed_Value := True; -- -gnatwb
Warn_On_Biased_Representation := True; -- -gnatw.b
Warn_On_Export_Import := True; -- -gnatwx
Warn_On_No_Value_Assigned := True; -- -gnatwv
Warn_On_Object_Renames_Function := True; -- -gnatw.r
Warn_On_Overlap := True; -- -gnatw.i
Warn_On_Parameter_Order := True; -- -gnatw.p
Warn_On_Questionable_Missing_Parens := True; -- -gnatwq
Warn_On_Redundant_Constructs := True; -- -gnatwr
Warn_On_Suspicious_Modulus_Value := True; -- -gnatw.m
end if;
-- -gnated switch (disable atomic synchronization)
when 'd' =>
Suppress_Options.Suppress (Atomic_Synchronization) :=
True;
-- -gnateD switch (preprocessing symbol definition)
when 'D' =>
Store_Switch := False;
Ptr := Ptr + 1;
if Ptr > Max then
Bad_Switch ("-gnateD");
end if;
Add_Symbol_Definition (Switch_Chars (Ptr .. Max));
-- Store the switch
Store_Compilation_Switch
("-gnateD" & Switch_Chars (Ptr .. Max));
Ptr := Max + 1;
-- -gnateE (extra exception information)
when 'E' =>
Exception_Extra_Info := True;
Ptr := Ptr + 1;
-- -gnatef (full source path for brief error messages)
when 'f' =>
Store_Switch := False;
Ptr := Ptr + 1;
Full_Path_Name_For_Brief_Errors := True;
-- -gnateF (Check_Float_Overflow)
when 'F' =>
Ptr := Ptr + 1;
Check_Float_Overflow := not Machine_Overflows_On_Target;
-- -gnateg (generate C code)
when 'g' =>
-- Special check, -gnateg must occur after -gnatc
if Operating_Mode /= Check_Semantics then
Osint.Fail
("gnateg requires previous occurrence of -gnatc");
end if;
Generate_C_Code := True;
Ptr := Ptr + 1;
-- -gnateG (save preprocessor output)
when 'G' =>
Generate_Processed_File := True;
Ptr := Ptr + 1;
-- -gnatei (max number of instantiations)
when 'i' =>
Ptr := Ptr + 1;
Scan_Pos
(Switch_Chars, Max, Ptr, Maximum_Instantiations, C);
-- -gnateI (index of unit in multi-unit source)
when 'I' =>
Ptr := Ptr + 1;
Scan_Pos (Switch_Chars, Max, Ptr, Multiple_Unit_Index, C);
-- -gnatel
when 'l' =>
Ptr := Ptr + 1;
Elab_Info_Messages := True;
-- -gnateL
when 'L' =>
Ptr := Ptr + 1;
Elab_Info_Messages := False;
-- -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
Bad_Switch ("-gnatem");
end if;
Mapping_File_Name :=
new String'(Switch_Chars (Ptr .. Max));
return;
-- -gnateO= (object path file)
-- This is an internal switch
when 'O' =>
Store_Switch := False;
Ptr := Ptr + 1;
-- Check for '='
if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
Bad_Switch ("-gnateO");
else
Object_Path_File_Name :=
new String'(Switch_Chars (Ptr + 1 .. Max));
end if;
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
Bad_Switch ("-gnatep");
end if;
Preprocessing_Data_File :=
new String'(Switch_Chars (Ptr .. Max));
-- Store the switch, normalizing to -gnatep=
Store_Compilation_Switch
("-gnatep=" & Preprocessing_Data_File.all);
Ptr := Max + 1;
-- -gnateP (Treat pragma Pure/Preelaborate errs as warnings)
when 'P' =>
Treat_Categorization_Errors_As_Warnings := True;
-- -gnates=file (specify extra file switches for gnat2why)
-- This is an internal switch
when 's' =>
if not First_Switch then
Osint.Fail
("-gnates must not be combined with other switches");
end if;
-- Check for '='
Ptr := Ptr + 1;
if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
Bad_Switch ("-gnates");
else
SPARK_Switches_File_Name :=
new String'(Switch_Chars (Ptr + 1 .. Max));
end if;
return;
-- -gnateS (generate SCO information)
-- Include Source Coverage Obligation information in ALI
-- files for use by source coverage analysis tools
-- (gnatcov) (equivalent to -fdump-scos, provided for
-- backwards compatibility).
when 'S' =>
Generate_SCO := True;
Generate_SCO_Instance_Table := True;
Ptr := Ptr + 1;
-- -gnatet (write target dependent information)
when 't' =>
if not First_Switch then
Osint.Fail
("-gnatet must not be combined with other switches");
end if;
-- Check for '='
Ptr := Ptr + 1;
if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
Bad_Switch ("-gnatet");
else
Target_Dependent_Info_Write_Name :=
new String'(Switch_Chars (Ptr + 1 .. Max));
end if;
return;
-- -gnateT (read target dependent information)
when 'T' =>
if not First_Switch then
Osint.Fail
("-gnateT must not be combined with other switches");
end if;
-- Check for '='
Ptr := Ptr + 1;
if Ptr >= Max or else Switch_Chars (Ptr) /= '=' then
Bad_Switch ("-gnateT");
else
-- This parameter was stored by Set_Targ earlier
pragma Assert
(Target_Dependent_Info_Read_Name.all =
Switch_Chars (Ptr + 1 .. Max));
null;
end if;
return;
-- -gnateu (unrecognized y,V,w switches)
when 'u' =>
Ptr := Ptr + 1;
Ignore_Unrecognized_VWY_Switches := True;
-- -gnateV (validity checks on parameters)
when 'V' =>
Ptr := Ptr + 1;
Check_Validity_Of_Parameters := True;
-- -gnateY (ignore Style_Checks pragmas)
when 'Y' =>
Ignore_Style_Checks_Pragmas := True;
Ptr := Ptr + 1;
-- -gnatez (final delimiter of explicit switches)
-- This is an internal switch
-- All switches that come after -gnatez have been added by
-- the GCC driver and are not stored in the ALI file. See
-- also -gnatea above.
when 'z' =>
Store_Switch := False;
Disable_Switch_Storing;
Ptr := Ptr + 1;
-- All other -gnate? switches are unassigned
when others =>
Bad_Switch ("-gnate" & Switch_Chars (Ptr .. Max));
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;
-- -gnatF (overflow of predefined float types)
when 'F' =>
Ptr := Ptr + 1;
External_Name_Exp_Casing := Uppercase;
External_Name_Imp_Casing := Uppercase;
-- -gnatg (GNAT implementation mode)
when 'g' =>
Ptr := Ptr + 1;
GNAT_Mode := True;
GNAT_Mode_Config := True;
Identifier_Character_Set := 'n';
System_Extend_Unit := Empty;
Warning_Mode := Treat_As_Error;
Style_Check_Main := True;
Ada_Version := Ada_2012;
Ada_Version_Explicit := Ada_2012;
Ada_Version_Pragma := Empty;
-- Set default warnings and style checks for -gnatg
Set_GNAT_Mode_Warnings;
Set_GNAT_Style_Check_Options;
-- -gnatG (output generated code)
when 'G' =>
Ptr := Ptr + 1;
Print_Generated_Code := True;
-- Scan optional integer line limit value
if Nat_Present (Switch_Chars, Max, Ptr) then
Scan_Nat (Switch_Chars, Max, Ptr, Sprint_Line_Limit, 'G');
Sprint_Line_Limit := Nat'Max (Sprint_Line_Limit, 40);
end if;
-- -gnath (help information)
when 'h' =>
Ptr := Ptr + 1;
Usage_Requested := True;
-- -gnatH (legacy static elaboration checking mode enabled)
when 'H' =>
Ptr := Ptr + 1;
Legacy_Elaboration_Checks := True;
-- -gnati (character set)
when 'i' =>
if Ptr = Max then
Bad_Switch ("-gnati");
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
Bad_Switch ("-gnati" & Switch_Chars (Ptr .. Max));
end if;
-- -gnatI (ignore representation clauses)
when 'I' =>
Ptr := Ptr + 1;
Ignore_Rep_Clauses := True;
-- -gnatj (messages in limited length lines)
when 'j' =>
Ptr := Ptr + 1;
Scan_Nat (Switch_Chars, Max, Ptr, Error_Msg_Line_Length, C);
-- -gnatJ (relaxed elaboration checking mode enabled)
when 'J' =>
Ptr := Ptr + 1;
Relaxed_Elaboration_Checks := True;
-- Common relaxations for both ABE mechanisms
--
-- -gnatd.G (ignore calls through generic formal parameters
-- for elaboration)
-- -gnatd.U (ignore indirect calls for static elaboration)
-- -gnatd.y (disable implicit pragma Elaborate_All on task
-- bodies)
Debug_Flag_Dot_GG := True;
Debug_Flag_Dot_UU := True;
Debug_Flag_Dot_Y := True;
-- Relaxatons to the legacy ABE mechanism
if Legacy_Elaboration_Checks then
null;
-- Relaxations to the default ABE mechanism
--
-- -gnatd_a (stop elaboration checks on accept or select
-- statement)
-- -gnatd_e (ignore entry calls and requeue statements for
-- elaboration)
-- -gnatd_i (ignore activations and calls to instances for
-- elaboration)
-- -gnatd_p (ignore assertion pragmas for elaboration)
-- -gnatd_s (stop elaboration checks on synchronous
-- suspension)
-- -gnatdL (ignore external calls from instances for
-- elaboration)
else
Debug_Flag_Underscore_A := True;
Debug_Flag_Underscore_E := True;
Debug_Flag_Underscore_I := True;
Debug_Flag_Underscore_P := True;
Debug_Flag_Underscore_S := True;
Debug_Flag_LL := True;
end if;
-- -gnatk (limit file name length)
when 'k' =>
Ptr := Ptr + 1;
Scan_Pos
(Switch_Chars, Max, Ptr, Maximum_File_Name_Length, C);
-- -gnatl (output full source)
when 'l' =>
Ptr := Ptr + 1;
Full_List := True;
-- There may be an equal sign between -gnatl and a file name
if Ptr <= Max and then Switch_Chars (Ptr) = '=' then
if Ptr = Max then
Osint.Fail ("file name for -gnatl= is null");
else
Opt.Full_List_File_Name :=
new String'(Switch_Chars (Ptr + 1 .. Max));
Ptr := Max + 1;
end if;
end if;
-- -gnatL (corresponding source text)
when 'L' =>
Ptr := Ptr + 1;
Dump_Source_Text := True;
-- -gnatm (max number or errors/warnings)
when 'm' =>
Ptr := Ptr + 1;
Scan_Nat (Switch_Chars, Max, Ptr, Maximum_Messages, C);
-- -gnatn (enable pragma Inline)
when 'n' =>
Ptr := Ptr + 1;
Inline_Active := True;
-- There may be a digit (1 or 2) appended to the switch
if Ptr <= Max then
C := Switch_Chars (Ptr);
if C in '1' .. '2' then
Ptr := Ptr + 1;
Inline_Level := Character'Pos (C) - Character'Pos ('0');
end if;
end if;
-- -gnatN (obsolescent)
when 'N' =>
Ptr := Ptr + 1;
Inline_Active := True;
Front_End_Inlining := True;
-- -gnato (overflow checks)
when 'o' =>
Ptr := Ptr + 1;
-- Case of -gnato0 (overflow checking turned off)
if Ptr <= Max and then Switch_Chars (Ptr) = '0' then
Ptr := Ptr + 1;
Suppress_Options.Suppress (Overflow_Check) := True;
-- We set strict mode in case overflow checking is turned
-- on locally (also records that we had a -gnato switch).
Suppress_Options.Overflow_Mode_General := Strict;
Suppress_Options.Overflow_Mode_Assertions := Strict;
-- All cases other than -gnato0 (overflow checking turned on)
else
Suppress_Options.Suppress (Overflow_Check) := False;
-- Case of no digits after the -gnato
if Ptr > Max
or else Switch_Chars (Ptr) not in '1' .. '3'
then
Suppress_Options.Overflow_Mode_General := Strict;
Suppress_Options.Overflow_Mode_Assertions := Strict;
-- At least one digit after the -gnato
else
-- Handle first digit after -gnato
Suppress_Options.Overflow_Mode_General :=
Get_Overflow_Mode (Switch_Chars (Ptr));
Ptr := Ptr + 1;
-- Only one digit after -gnato, set assertions mode to be
-- the same as general mode.
if Ptr > Max
or else Switch_Chars (Ptr) not in '1' .. '3'
then
Suppress_Options.Overflow_Mode_Assertions :=
Suppress_Options.Overflow_Mode_General;
-- Process second digit after -gnato
else
Suppress_Options.Overflow_Mode_Assertions :=
Get_Overflow_Mode (Switch_Chars (Ptr));
Ptr := Ptr + 1;
end if;
end if;
end if;
-- -gnatO (specify name of the object file)
-- This is an internal switch
when 'O' =>
Store_Switch := False;
Ptr := Ptr + 1;
Output_File_Name_Present := True;
-- -gnatp (suppress all checks)
when 'p' =>
Ptr := Ptr + 1;
-- Skip processing if cancelled by subsequent -gnat-p
if Switch_Subsequently_Cancelled ("p", Args, Arg_Rank) then
Store_Switch := False;
else
-- Set all specific options as well as All_Checks in the
-- Suppress_Options array, excluding Elaboration_Check,
-- since this is treated specially because we do not want
-- -gnatp to disable static elaboration processing. Also
-- exclude Atomic_Synchronization, since this is not a real
-- check.
for J in Suppress_Options.Suppress'Range loop
if J /= Elaboration_Check
and then
J /= Atomic_Synchronization
then
Suppress_Options.Suppress (J) := True;
end if;
end loop;
Validity_Checks_On := False;
Opt.Suppress_Checks := True;
-- Set overflow mode checking to strict in case it gets
-- turned on locally (also signals that overflow checking
-- has been specifically turned off).
Suppress_Options.Overflow_Mode_General := Strict;
Suppress_Options.Overflow_Mode_Assertions := Strict;
end if;
-- -gnatP (periodic poll)
when 'P' =>
Ptr := Ptr + 1;
Polling_Required := True;
-- -gnatq (don't quit)
when 'q' =>
Ptr := Ptr + 1;
Try_Semantics := True;
-- -gnatQ (always write ALI file)
when 'Q' =>
Ptr := Ptr + 1;
Force_ALI_Tree_File := True;
Try_Semantics := True;
-- -gnatr (restrictions as warnings)
when 'r' =>
Ptr := Ptr + 1;
Treat_Restrictions_As_Warnings := True;
-- -gnatR (list rep. info)
when 'R' =>
-- Not allowed if previous -gnatD given. See more extensive
-- comments in the 'D' section for the inverse test.
if Debug_Generated_Code then
Osint.Fail
("-gnatR not permitted since -gnatD given previously");
end if;
-- Set to annotate rep info, and set default -gnatR mode
Back_Annotate_Rep_Info := True;
List_Representation_Info := 1;
-- Scan possible parameter
Ptr := Ptr + 1;
while Ptr <= Max loop
C := Switch_Chars (Ptr);
case C is
when '0' .. '4' =>
List_Representation_Info :=
Character'Pos (C) - Character'Pos ('0');
when 's' =>
List_Representation_Info_To_File := True;
when 'j' =>
List_Representation_Info_To_JSON := True;
when 'm' =>
List_Representation_Info_Mechanisms := True;
when 'e' =>
List_Representation_Info_Extended := True;
when others =>
Bad_Switch ("-gnatR" & Switch_Chars (Ptr .. Max));
end case;
Ptr := Ptr + 1;
end loop;
if List_Representation_Info_To_JSON
and then List_Representation_Info_Extended
then
Osint.Fail ("-gnatRe is incompatible with -gnatRj");
end if;
-- -gnats (syntax check only)
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;
-- -gnatS (print package Standard)
when 'S' =>
Print_Standard := True;
Ptr := Ptr + 1;
-- -gnatt (output tree)
when 't' =>
Ptr := Ptr + 1;
Tree_Output := True;
Back_Annotate_Rep_Info := True;
-- -gnatT (change start of internal table sizes)
when 'T' =>
Ptr := Ptr + 1;
Scan_Pos (Switch_Chars, Max, Ptr, Table_Factor, C);
-- -gnatu (list units for compilation)
when 'u' =>
Ptr := Ptr + 1;
List_Units := True;
-- -gnatU (unique tags)
when 'U' =>
Ptr := Ptr + 1;
Unique_Error_Tag := True;
-- -gnatv (verbose mode)
when 'v' =>
Ptr := Ptr + 1;
Verbose_Mode := True;
-- -gnatV (validity checks)
when 'V' =>
Store_Switch := False;
Ptr := Ptr + 1;
if Ptr > Max then
Bad_Switch ("-gnatV");
else
declare
OK : Boolean;
begin
Set_Validity_Check_Options
(Switch_Chars (Ptr .. Max), OK, Ptr);
if not OK then
Bad_Switch ("-gnatV" & Switch_Chars (Ptr .. Max));
end if;
for Index in First_Char + 1 .. Max loop
Store_Compilation_Switch
("-gnatV" & Switch_Chars (Index));
end loop;
end;
end if;
Ptr := Max + 1;
-- -gnatw (warning modes)
when 'w' =>
Store_Switch := False;
Ptr := Ptr + 1;
if Ptr > Max then
Bad_Switch ("-gnatw");
end if;
while Ptr <= Max loop
C := Switch_Chars (Ptr);
-- Case of dot switch
if C = '.' and then Ptr < Max then
Ptr := Ptr + 1;
C := Switch_Chars (Ptr);
if Set_Dot_Warning_Switch (C) then
Store_Compilation_Switch ("-gnatw." & C);
else
Bad_Switch ("-gnatw." & Switch_Chars (Ptr .. Max));
end if;
-- Case of underscore switch
elsif C = '_' and then Ptr < Max then
Ptr := Ptr + 1;
C := Switch_Chars (Ptr);
if Set_Underscore_Warning_Switch (C) then
Store_Compilation_Switch ("-gnatw_" & C);
else
Bad_Switch ("-gnatw_" & Switch_Chars (Ptr .. Max));
end if;
-- Normal case
else
if Set_Warning_Switch (C) then
Store_Compilation_Switch ("-gnatw" & C);
else
Bad_Switch ("-gnatw" & Switch_Chars (Ptr .. Max));
end if;
end if;
Ptr := Ptr + 1;
end loop;
return;
-- -gnatW (wide character encoding method)
when 'W' =>
Ptr := Ptr + 1;
if Ptr > Max then
Bad_Switch ("-gnatW");
end if;
begin
Wide_Character_Encoding_Method :=
Get_WC_Encoding_Method (Switch_Chars (Ptr));
exception
when Constraint_Error =>
Bad_Switch ("-gnatW" & Switch_Chars (Ptr .. Max));
end;
Wide_Character_Encoding_Method_Specified := True;
Upper_Half_Encoding :=
Wide_Character_Encoding_Method in
WC_Upper_Half_Encoding_Method;
Ptr := Ptr + 1;
-- -gnatx (suppress cross-ref information)
when 'x' =>
Ptr := Ptr + 1;
Xref_Active := False;
-- -gnatX (language extensions)
when 'X' =>
Ptr := Ptr + 1;
Extensions_Allowed := True;
Ada_Version := Ada_Version_Type'Last;
Ada_Version_Explicit := Ada_Version_Type'Last;
Ada_Version_Pragma := Empty;
-- -gnaty (style checks)
when 'y' =>
Ptr := Ptr + 1;
Style_Check_Main := True;
if Ptr > Max then
Set_Default_Style_Check_Options;
else
Store_Switch := False;
declare
OK : Boolean;
begin
Set_Style_Check_Options
(Switch_Chars (Ptr .. Max), OK, Ptr);
if not OK then
Osint.Fail
("bad -gnaty switch (" &
Style_Msg_Buf (1 .. Style_Msg_Len) & ')');
end if;
Ptr := First_Char + 1;
while Ptr <= Max loop
if Switch_Chars (Ptr) = 'M' then
First_Char := Ptr;
loop
Ptr := Ptr + 1;
exit when Ptr > Max
or else Switch_Chars (Ptr) not in '0' .. '9';
end loop;
Store_Compilation_Switch
("-gnaty" & Switch_Chars (First_Char .. Ptr - 1));
else
Store_Compilation_Switch
("-gnaty" & Switch_Chars (Ptr));
Ptr := Ptr + 1;
end if;
end loop;
end;
end if;
-- -gnatz (stub generation)
when 'z' =>
-- -gnatz must be the first and only switch in Switch_Chars,
-- and is a two-letter switch.
if Ptr /= Switch_Chars'First + 5
or else (Max - Ptr + 1) > 2
then
Osint.Fail
("-gnatz* may not be combined with other switches");
end if;
if Ptr = Max then
Bad_Switch ("-gnatz");
end if;
Ptr := Ptr + 1;
-- Only one occurrence of -gnat* is permitted
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 =>
Bad_Switch ("-gnatz" & Switch_Chars (Ptr .. Max));
end case;
Ptr := Ptr + 1;
else
Osint.Fail ("only one -gnatz* switch allowed");
end if;
-- -gnatZ (obsolescent)
when 'Z' =>
Ptr := Ptr + 1;
Osint.Fail
("-gnatZ is no longer supported: consider using --RTS=zcx");
-- Note on language version switches: whenever a new language
-- version switch is added, Switch.M.Normalize_Compiler_Switches
-- must be updated.
-- -gnat83
when '8' =>
if Ptr = Max then
Bad_Switch ("-gnat8");
end if;
Ptr := Ptr + 1;
if Switch_Chars (Ptr) /= '3' or else Latest_Ada_Only then
Bad_Switch ("-gnat8" & Switch_Chars (Ptr .. Max));
else
Ptr := Ptr + 1;
Ada_Version := Ada_83;
Ada_Version_Explicit := Ada_83;
Ada_Version_Pragma := Empty;
end if;
-- -gnat95
when '9' =>
if Ptr = Max then
Bad_Switch ("-gnat9");
end if;
Ptr := Ptr + 1;
if Switch_Chars (Ptr) /= '5' or else Latest_Ada_Only then
Bad_Switch ("-gnat9" & Switch_Chars (Ptr .. Max));
else
Ptr := Ptr + 1;
Ada_Version := Ada_95;
Ada_Version_Explicit := Ada_95;
Ada_Version_Pragma := Empty;
end if;
-- -gnat05
when '0' =>
if Ptr = Max then
Bad_Switch ("-gnat0");
end if;
Ptr := Ptr + 1;
if Switch_Chars (Ptr) /= '5' or else Latest_Ada_Only then
Bad_Switch ("-gnat0" & Switch_Chars (Ptr .. Max));
else
Ptr := Ptr + 1;
Ada_Version := Ada_2005;
Ada_Version_Explicit := Ada_2005;
Ada_Version_Pragma := Empty;
end if;
-- -gnat12
when '1' =>
if Ptr = Max then
Bad_Switch ("-gnat1");
end if;
Ptr := Ptr + 1;
if Switch_Chars (Ptr) /= '2' then
Bad_Switch ("-gnat1" & Switch_Chars (Ptr .. Max));
else
Ptr := Ptr + 1;
Ada_Version := Ada_2012;
Ada_Version_Explicit := Ada_2012;
Ada_Version_Pragma := Empty;
end if;
-- -gnat2005 and -gnat2012
when '2' =>
if Ptr > Max - 3 then
Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
elsif Switch_Chars (Ptr .. Ptr + 3) = "2005"
and then not Latest_Ada_Only
then
Ada_Version := Ada_2005;
elsif Switch_Chars (Ptr .. Ptr + 3) = "2012" then
Ada_Version := Ada_2012;
elsif Switch_Chars (Ptr .. Ptr + 3) = "2020" then
Ada_Version := Ada_2020;
else
Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Ptr + 3));
end if;
Ada_Version_Explicit := Ada_Version;
Ada_Version_Pragma := Empty;
Ptr := Ptr + 4;
-- Switch cancellation, currently only -gnat-p is allowed.
-- All we do here is the error checking, since the actual
-- processing for switch cancellation is done by calls to
-- Switch_Subsequently_Cancelled at the appropriate point.
when '-' =>
-- Simple ignore -gnat-p
if Switch_Chars = "-gnat-p" then
return;
-- Any other occurrence of minus is ignored. This is for
-- maximum compatibility with previous version which ignored
-- all occurrences of minus.
else
Store_Switch := False;
Ptr := Ptr + 1;
end if;
-- We ignore '/' in switches, this is historical, still needed???
when '/' =>
Store_Switch := False;
-- Anything else is an error (illegal switch character)
when others =>
Bad_Switch ("-gnat" & Switch_Chars (Ptr .. Max));
end case;
if Store_Switch then
Store_Compilation_Switch
("-gnat" & Switch_Chars (First_Char .. Ptr - 1));
end if;
First_Switch := False;
end loop;
end if;
end Scan_Front_End_Switches;
-----------------------------------
-- Switch_Subsequently_Cancelled --
-----------------------------------
function Switch_Subsequently_Cancelled
(C : String;
Args : String_List;
Arg_Rank : Positive) return Boolean
is
begin
-- Loop through arguments following the current one
for Arg in Arg_Rank + 1 .. Args'Last loop
if Args (Arg).all = "-gnat-" & C then
return True;
end if;
end loop;
-- No match found, not cancelled
return False;
end Switch_Subsequently_Cancelled;
end Switch.C;