Skip to content

R
riscv-gcc-1
Commit b26be063 by Arnaud Charlet
Options

[multiple changes] 

2010-06-17  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb: propagate Pragma_Enabled flag to generic.
	* get_scos.adb: Set C2 flag in decision entry of pragma to 'e' (enabled)
	* par_sco.ads, par_sco.adb (Set_SCO_Pragma_Enabled): New procedure
	Remove use of Node field in SCOs table
	(Output_Header): Set 'd' to initially disable pragma entry
	* put_scos.adb (Put_SCOs): New flag indicating if pragma is enabled
	* scos.ads, scos.adb: Remove Node field from internal SCOs table.
	Use C2 field of pragma decision header to indicate enabled.
	* sem_prag.adb: Add calls to Set_SCO_Pragma_Enabled.
	* gcc-interface/Make-lang.in: Update dependencies.

2010-06-17  Vincent Celier  <celier@adacore.com>

	* back_end.adb (Next_Arg): Moved to procedure Scan_Compiler_Arguments
	(Scan_Compiler_Arguments): Call Scan_Front_End_Switches with Next_Arg
	(Switch_Subsequently_Cancelled): Function moved to the body of Switch.C
	* back_end.ads (Scan_Front_End_Switches): Function moved to the body of
	Switch.C.
	* switch-c.adb: Copied a number of global declarations from back_end.adb
	(Len_Arg): New function copied from back_end.adb
	(Switch_Subsequently_Cancelled): New function moved from back_end.adb
	(Scan_Front_End_Switches): New parameter Arg_Rank used to call
	Switch_Subsequently_Cancelled.
	* switch-c.ads (Scan_Front_End_Switches): New parameter Arg_Rank.
	* gcc-interface/Makefile.in: Add line so that shared libgnat is linked
	with -lexc on Tru64.

From-SVN: r160878
parent 038253e6
Showing with 269 additions and 142 deletions
gcc/ada/ChangeLog
2010-06-17 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb: propagate Pragma_Enabled flag to generic.
* get_scos.adb: Set C2 flag in decision entry of pragma to 'e' (enabled)
* par_sco.ads, par_sco.adb (Set_SCO_Pragma_Enabled): New procedure
Remove use of Node field in SCOs table
(Output_Header): Set 'd' to initially disable pragma entry
* put_scos.adb (Put_SCOs): New flag indicating if pragma is enabled
* scos.ads, scos.adb: Remove Node field from internal SCOs table.
Use C2 field of pragma decision header to indicate enabled.
* sem_prag.adb: Add calls to Set_SCO_Pragma_Enabled.
* gcc-interface/Make-lang.in: Update dependencies.
2010-06-17 Vincent Celier <celier@adacore.com>
* back_end.adb (Next_Arg): Moved to procedure Scan_Compiler_Arguments
(Scan_Compiler_Arguments): Call Scan_Front_End_Switches with Next_Arg
(Switch_Subsequently_Cancelled): Function moved to the body of Switch.C
* back_end.ads (Scan_Front_End_Switches): Function moved to the body of
Switch.C.
* switch-c.adb: Copied a number of global declarations from back_end.adb
(Len_Arg): New function copied from back_end.adb
(Switch_Subsequently_Cancelled): New function moved from back_end.adb
(Scan_Front_End_Switches): New parameter Arg_Rank used to call
Switch_Subsequently_Cancelled.
* switch-c.ads (Scan_Front_End_Switches): New parameter Arg_Rank.
* gcc-interface/Makefile.in: Add line so that shared libgnat is linked
with -lexc on Tru64.
2010-06-17 Robert Dewar <dewar@adacore.com>
* prj.ads, prj.adb: Minor reformatting
......
gcc/ada/back_end.adb
......@@ -46,10 +46,6 @@ package body Back_End is
type Arg_Array_Ptr is access Arg_Array;
-- Types to access compiler arguments
Next_Arg : Pos := 1;
-- Next argument to be scanned by Scan_Compiler_Arguments. We make this
-- global so that it can be accessed by Switch_Subsequently_Cancelled.
flag_stack_check : Int;
pragma Import (C, flag_stack_check);
-- Indicates if stack checking is enabled, imported from toplev.c
......@@ -166,6 +162,9 @@ package body Back_End is
procedure Scan_Compiler_Arguments is
Next_Arg : Pos;
-- Next argument to be scanned
Output_File_Name_Seen : Boolean := False;
-- Set to True after having scanned file_name for switch "-gnatO file"
......@@ -232,6 +231,7 @@ package body Back_End is
-- Loop through command line arguments, storing them for later access
Next_Arg := 1;
while Next_Arg < save_argc loop
Look_At_Arg : declare
Argv_Ptr : constant Big_String_Ptr := save_argv (Next_Arg);
......@@ -284,7 +284,7 @@ package body Back_End is
Opt.No_Stdlib := True;
elsif Is_Front_End_Switch (Argv) then
Scan_Front_End_Switches (Argv);
Scan_Front_End_Switches (Argv, Next_Arg);
-- All non-front-end switches are back-end switches
......@@ -296,32 +296,4 @@ package body Back_End is
Next_Arg := Next_Arg + 1;
end loop;
end Scan_Compiler_Arguments;
-----------------------------------
-- Switch_Subsequently_Cancelled --
-----------------------------------
function Switch_Subsequently_Cancelled (C : String) return Boolean is
Arg : Pos;
begin
Arg := Next_Arg + 1;
while Arg < save_argc loop
declare
Argv_Ptr : constant Big_String_Ptr := save_argv (Arg);
Argv_Len : constant Nat := Len_Arg (Arg);
Argv : constant String :=
Argv_Ptr (1 .. Natural (Argv_Len));
begin
if Argv = "-gnat-" & C then
return True;
end if;
end;
Arg := Arg + 1;
end loop;
return False;
end Switch_Subsequently_Cancelled;
end Back_End;
gcc/ada/back_end.ads
......@@ -61,11 +61,4 @@ package Back_End is
-- Any processed switches that influence the result of a compilation must
-- be added to the Compilation_Arguments table.
function Switch_Subsequently_Cancelled (C : String) 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.
end Back_End;
gcc/ada/gcc-interface/Make-lang.in
......@@ -1834,21 +1834,22 @@ ada/exp_ch4.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/get_targ.ads ada/gnat.ads ada/g-htable.ads ada/hostparm.ads \
ada/inline.ads ada/itypes.ads ada/lib.ads ada/namet.ads ada/nlists.ads \
ada/nlists.adb ada/nmake.ads ada/nmake.adb ada/opt.ads ada/output.ads \
ada/restrict.ads ada/restrict.adb ada/rident.ads ada/rtsfind.ads \
ada/sem.ads ada/sem_aux.ads ada/sem_cat.ads ada/sem_ch13.ads \
ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch8.ads ada/sem_eval.ads \
ada/sem_eval.adb ada/sem_res.ads ada/sem_scil.ads ada/sem_type.ads \
ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads ada/sinfo.adb \
ada/sinput.ads ada/snames.ads ada/sprint.ads ada/stand.ads \
ada/stringt.ads ada/stringt.adb ada/system.ads ada/s-exctab.ads \
ada/s-exctab.adb ada/s-htable.ads ada/s-imenne.ads ada/s-memory.ads \
ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads ada/s-soflin.ads \
ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads ada/s-stoele.adb \
ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads \
ada/table.ads ada/table.adb ada/targparm.ads ada/tbuild.ads \
ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads ada/types.ads \
ada/uintp.ads ada/uintp.adb ada/uname.ads ada/unchconv.ads \
ada/unchdeal.ads ada/urealp.ads ada/urealp.adb ada/validsw.ads
ada/par_sco.ads ada/restrict.ads ada/restrict.adb ada/rident.ads \
ada/rtsfind.ads ada/sem.ads ada/sem_aux.ads ada/sem_cat.ads \
ada/sem_ch13.ads ada/sem_ch3.ads ada/sem_ch6.ads ada/sem_ch8.ads \
ada/sem_eval.ads ada/sem_eval.adb ada/sem_res.ads ada/sem_scil.ads \
ada/sem_type.ads ada/sem_util.ads ada/sem_warn.ads ada/sinfo.ads \
ada/sinfo.adb ada/sinput.ads ada/snames.ads ada/sprint.ads \
ada/stand.ads ada/stringt.ads ada/stringt.adb ada/system.ads \
ada/s-exctab.ads ada/s-exctab.adb ada/s-htable.ads ada/s-imenne.ads \
ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads ada/s-rident.ads \
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/targparm.ads \
ada/tbuild.ads ada/tbuild.adb ada/tree_io.ads ada/ttypes.ads \
ada/types.ads ada/uintp.ads ada/uintp.adb ada/uname.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/urealp.adb \
ada/validsw.ads
ada/exp_ch5.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
......@@ -2911,11 +2912,16 @@ ada/prepcomp.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads ada/widechar.ads
ada/put_scos.o : ada/ada.ads ada/a-unccon.ads ada/gnat.ads ada/g-table.ads \
ada/g-table.adb ada/put_scos.ads ada/put_scos.adb ada/scos.ads \
ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-stalib.ads \
ada/s-unstyp.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads \
ada/atree.ads ada/sinfo.ads ada/snames.ads
ada/put_scos.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/debug.ads \
ada/einfo.ads ada/gnat.ads ada/g-table.ads ada/g-table.adb \
ada/hostparm.ads ada/namet.ads ada/opt.ads ada/output.ads \
ada/put_scos.ads ada/put_scos.adb ada/scos.ads ada/sinfo.ads \
ada/snames.ads ada/system.ads ada/s-exctab.ads ada/s-memory.ads \
ada/s-os_lib.ads ada/s-parame.ads ada/s-stalib.ads ada/s-string.ads \
ada/s-traent.ads ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads \
ada/table.adb ada/tree_io.ads ada/types.ads ada/uintp.ads \
ada/unchconv.ads ada/unchdeal.ads ada/urealp.ads
ada/repinfo.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/atree.ads ada/atree.adb \
......@@ -4194,15 +4200,16 @@ ada/switch-b.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/types.ads ada/unchconv.ads ada/unchdeal.ads
ada/switch-c.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/debug.ads ada/gnatvsn.ads \
ada/hostparm.ads ada/lib.ads ada/namet.ads ada/opt.ads ada/osint.ads \
ada/output.ads ada/prepcomp.ads ada/sem_warn.ads ada/stylesw.ads \
ada/switch.ads ada/switch-c.ads ada/switch-c.adb ada/system.ads \
ada/s-exctab.ads ada/s-memory.ads ada/s-os_lib.ads ada/s-parame.ads \
ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads ada/s-stoele.ads \
ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads ada/s-unstyp.ads \
ada/s-wchcon.ads ada/table.ads ada/table.adb ada/tree_io.ads \
ada/types.ads ada/unchconv.ads ada/unchdeal.ads ada/validsw.ads
ada/a-uncdea.ads ada/alloc.ads ada/back_end.ads ada/debug.ads \
ada/gnatvsn.ads ada/hostparm.ads ada/lib.ads ada/namet.ads ada/opt.ads \
ada/osint.ads ada/output.ads ada/prepcomp.ads ada/sem_warn.ads \
ada/stylesw.ads ada/switch.ads ada/switch-c.ads ada/switch-c.adb \
ada/system.ads ada/s-exctab.ads ada/s-memory.ads ada/s-os_lib.ads \
ada/s-parame.ads ada/s-soflin.ads ada/s-stache.ads ada/s-stalib.ads \
ada/s-stoele.ads ada/s-stoele.adb ada/s-string.ads ada/s-traent.ads \
ada/s-unstyp.ads ada/s-wchcon.ads ada/table.ads ada/table.adb \
ada/tree_io.ads ada/types.ads ada/unchconv.ads ada/unchdeal.ads \
ada/validsw.ads
ada/switch.o : ada/ada.ads ada/a-except.ads ada/a-unccon.ads \
ada/a-uncdea.ads ada/alloc.ads ada/debug.ads ada/gnatvsn.ads \
......
gcc/ada/gcc-interface/Makefile.in
......@@ -1451,6 +1451,7 @@ ifeq ($(strip $(filter-out alpha% dec osf%,$(targ))),)
EH_MECHANISM=-gcc
GMEM_LIB=gmemlib
MISCLIB = -lexc
THREADSLIB = -lpthread -lmach -lexc -lrt
GNATLIB_SHARED = gnatlib-shared-default
LIBRARY_VERSION := $(LIB_VERSION)
......
gcc/ada/get_scos.adb
......@@ -315,6 +315,7 @@ begin
declare
Loc : Source_Location;
C2v : Character;
begin
-- Acquire location information
......@@ -325,9 +326,18 @@ begin
Get_Source_Location (Loc);
end if;
-- C2 is a space except for pragmas where it is 'e' since
-- clearly the pragma is enabled if it was written out.
if C = 'P' then
C2v := 'e';
else
C2v := ' ';
end if;
Add_SCO
(C1 => Dtyp,
C2 => ' ',
C2 => C2v,
From => Loc,
To => No_Source_Location,
Last => False);
......
gcc/ada/par_sco.adb
......@@ -63,13 +63,14 @@ package body Par_SCO is
Table_Increment => 200,
Table_Name => "SCO_Unit_Number_Entry");
--------------------------
-- Condition Hash Table --
--------------------------
---------------------------------
-- Condition/Pragma Hash Table --
---------------------------------
-- We need to be able to get to conditions quickly for handling the calls
-- to Set_SCO_Condition efficiently. For this purpose we identify the
-- conditions in the table by their starting sloc, and use the following
-- to Set_SCO_Condition efficiently, and similarly to get to pragmas to
-- handle calls to Set_SCO_Pragma_Enabled. For this purpose we identify the
-- conditions and pragmas in the table by their starting sloc, and use this
-- hash table to map from these starting sloc values to SCO_Table indexes.
type Header_Num is new Integer range 0 .. 996;
......@@ -81,7 +82,7 @@ package body Par_SCO is
function Equal (F1, F2 : Source_Ptr) return Boolean;
-- Function to test two keys for equality
package Condition_Hash_Table is new Simple_HTable
package Condition_Pragma_Hash_Table is new Simple_HTable
(Header_Num, Int, 0, Source_Ptr, Hash, Equal);
-- The actual hash table
......@@ -116,7 +117,6 @@ package body Par_SCO is
C2 : Character;
From : Source_Ptr;
To : Source_Ptr;
Node : Node_Id;
Last : Boolean);
-- Append an entry to SCO_Table with fields set as per arguments
......@@ -232,11 +232,6 @@ package body Par_SCO is
Write_Str (" False");
end if;
if Present (T.Node) then
Write_Str (" Node = ");
Write_Int (Int (T.Node));
end if;
Write_Eol;
end;
end loop;
......@@ -409,7 +404,6 @@ package body Par_SCO is
C2 => ' ',
From => Sloc (N),
To => No_Location,
Node => Empty,
Last => False);
Output_Decision_Operand (L);
......@@ -436,9 +430,8 @@ package body Par_SCO is
C2 => 'c',
From => FSloc,
To => LSloc,
Node => Empty,
Last => False);
Condition_Hash_Table.Set (FSloc, SCO_Table.Last);
Condition_Pragma_Hash_Table.Set (FSloc, SCO_Table.Last);
end Output_Element;
-------------------
......@@ -458,26 +451,32 @@ package body Par_SCO is
C2 => ' ',
From => Sloc (Parent (N)),
To => No_Location,
Node => Empty,
Last => False);
when 'P' =>
-- For PRAGMA, we must record the pragma node. Argument N
-- is the pragma argument, and we have to go up two levels
-- (through the pragma argument association) to get to the
-- pragma node itself.
-- For PRAGMA, we must get the location from the pragma node.
-- Argument N is the pragma argument, and we have to go up two
-- levels (through the pragma argument association) to get to
-- the pragma node itself.
declare
Pnode : constant Node_Id := Parent (Parent (N));
Loc : constant Source_Ptr := Sloc (Parent (Parent (N)));
begin
Set_Table_Entry
(C1 => 'P',
C2 => ' ',
From => Sloc (Pnode),
C2 => 'd',
From => Loc,
To => No_Location,
Node => Pnode,
Last => False);
-- For pragmas we also must make an entry in the hash table
-- for later access by Set_SCO_Pragma_Enabled. We set the
-- pragma as disabled above, the call will change C2 to 'e'
-- to enable the pragma header entry.
Condition_Pragma_Hash_Table.Set (Loc, SCO_Table.Last);
end;
when 'X' =>
......@@ -489,7 +488,6 @@ package body Par_SCO is
C2 => ' ',
From => No_Location,
To => No_Location,
Node => Empty,
Last => False);
-- No other possibilities
......@@ -821,13 +819,38 @@ package body Par_SCO is
(False => 'f', True => 't');
begin
Sloc_Range (Orig, Start, Dummy);
Index := Condition_Hash_Table.Get (Start);
Index := Condition_Pragma_Hash_Table.Get (Start);
-- The test here for zero is to deal with possible previous errors
if Index /= 0 then
pragma Assert (SCO_Table.Table (Index).C1 = ' ');
SCO_Table.Table (Index).C2 := Constant_Condition_Code (Val);
end if;
end Set_SCO_Condition;
----------------------------
-- Set_SCO_Pragma_Enabled --
----------------------------
procedure Set_SCO_Pragma_Enabled (Loc : Source_Ptr) is
Index : Nat;
begin
-- Note: the reason we use the Sloc value as the key is that in the
-- generic case, the call to this procedure is made on a copy of the
-- original node, so we can't use the Node_Id value.
Index := Condition_Pragma_Hash_Table.Get (Loc);
-- The test here for zero is to deal with possible previous errors
if Index /= 0 then
pragma Assert (SCO_Table.Table (Index).C1 = 'P');
SCO_Table.Table (Index).C2 := 'e';
end if;
end Set_SCO_Pragma_Enabled;
---------------------
-- Set_Table_Entry --
---------------------
......@@ -837,7 +860,6 @@ package body Par_SCO is
C2 : Character;
From : Source_Ptr;
To : Source_Ptr;
Node : Node_Id;
Last : Boolean)
is
function To_Source_Location (S : Source_Ptr) return Source_Location;
......@@ -866,7 +888,6 @@ package body Par_SCO is
C2 => C2,
From => To_Source_Location (From),
To => To_Source_Location (To),
Node => Node,
Last => Last);
end Set_Table_Entry;
......@@ -1001,7 +1022,6 @@ package body Par_SCO is
C2 => SCE.Typ,
From => SCE.From,
To => SCE.To,
Node => Empty,
Last => (J = SC_Last));
end;
end loop;
......@@ -1397,7 +1417,6 @@ package body Par_SCO is
C2 => ' ',
From => First,
To => Last,
Node => Empty,
Last => True);
-- Now output any embedded decisions
......@@ -1423,7 +1442,6 @@ package body Par_SCO is
Handler : Node_Id;
begin
-- For package bodies without a statement part, the parser adds an empty
-- one, to normalize the representation. The null statement therein,
-- which does not come from source, does not get a SCO.
......
gcc/ada/par_sco.ads
......@@ -49,6 +49,14 @@ package Par_SCO is
-- by Val. The condition is identified by the First_Sloc value in the
-- original tree associated with Cond.
procedure Set_SCO_Pragma_Enabled (Loc : Source_Ptr);
-- This procedure is called from Sem_Prag when a pragma is enabled (i.e.
-- when the Pragma_Enabled flag is set). Loc is the Sloc of the N_Pragma
-- node. This is used to enable the corresponding SCO table entry. Note
-- that we use the Sloc as the key here, since in the generic case, the
-- analysis is on a copy of the node, which is different from the node
-- seen by Par_SCO in the parse tree (but the Sloc values are the same).
procedure SCO_Output;
-- Outputs SCO lines for all units, with appropriate section headers, for
-- unit U in the ALI file, as recorded by previous calls to SCO_Record,
......
gcc/ada/put_scos.adb
......@@ -23,9 +23,7 @@
-- --
------------------------------------------------------------------------------
with Atree; use Atree;
with SCOs; use SCOs;
with Sinfo; use Sinfo;
with SCOs; use SCOs;
procedure Put_SCOs is
Ctr : Nat;
......@@ -147,17 +145,9 @@ begin
when 'I' | 'E' | 'P' | 'W' | 'X' =>
Start := Start + 1;
-- For disabled pragma, skip decision output. Note that
-- if the SCO table has been populated by Get_SCOs
-- (re-reading previously generated SCO information),
-- then the Node field of pragma entries is Empty. This
-- is the only way that Node can be Empty, so if we see
-- an Empty node field, we know the pragma is enabled.
if T.C1 = 'P'
and then Present (T.Node)
and then not Pragma_Enabled (Original_Node (T.Node))
then
-- For disabled pragma, skip decision output
if T.C1 = 'P' and then T.C2 = 'd' then
while not SCO_Table.Table (Start).Last loop
Start := Start + 1;
end loop;
......
gcc/ada/scos.adb
......@@ -34,11 +34,10 @@ package body SCOs is
To : Source_Location := No_Source_Location;
C1 : Character := ' ';
C2 : Character := ' ';
Node : Node_Id := Empty;
Last : Boolean := False)
is
begin
SCO_Table.Append ((From, To, Node, C1, C2, Last));
SCO_Table.Append ((From, To, C1, C2, Last));
end Add_SCO;
----------------
......
gcc/ada/scos.ads
......@@ -286,7 +286,6 @@ package SCOs is
type SCO_Table_Entry is record
From : Source_Location;
To : Source_Location;
Node : Node_Id;
C1 : Character;
C2 : Character;
Last : Boolean;
......@@ -306,7 +305,6 @@ package SCOs is
-- C2 = statement type code to appear on CS line (or ' ' if none)
-- From = starting source location
-- To = ending source location
-- Node = Empty
-- Last = False for all but the last entry, True for last entry
-- Note: successive statements (possibly interspersed with entries of
......@@ -321,32 +319,32 @@ package SCOs is
-- C2 = ' '
-- From = IF/EXIT/WHILE token
-- To = No_Source_Location
-- Node = Empty
-- Last = unused
-- Decision (PRAGMA)
-- C1 = 'P'
-- C2 = ' '
-- C2 = 'e'/'d' for enabled/disabled
-- From = PRAGMA token
-- To = No_Source_Location
-- Node = N_Pragma node or Empty when reading SCO data (see below)
-- Last = unused
-- Note: when the parse tree is first scanned, we unconditionally build
-- a pragma decision entry for any decision in a pragma (here as always
-- in SCO contexts, the only relevant pragmas are Assert, Check,
-- Precondition and Postcondition). Then when we output the SCO info
-- to the ALI file, we use the Node field to check the Pragma_Enabled
-- flag, and if it is False, we suppress output of the pragma decision
-- line. On reading back SCO data from an ALI file, the Node field is
-- always set to Empty.
-- in SCO contexts, the only pragmas with decisions are Assert, Check,
-- Precondition and Postcondition), and we mark the pragma as disabled.
--
-- During analysis, if the pragma is enabled, Set_SCO_Pragma_Enabled to
-- mark the SCO decision table entry as enabled (C2 set to 'e'). Then
-- in Put_SCOs, we only output the decision for a pragma if C2 is 'e'.
--
-- When we read SCOs from an ALI file (in Get_SCOs), we always set C2
-- to 'e', since clearly the pragma is enabled if it was written out.
-- Decision (Expression)
-- C1 = 'X'
-- C2 = ' '
-- From = No_Source_Location
-- To = No_Source_Location
-- Node = Empty
-- Last = unused
-- Operator
......@@ -354,7 +352,6 @@ package SCOs is
-- C2 = ' '
-- From = location of NOT/AND/OR token
-- To = No_Source_Location
-- Node = Empty
-- Last = False
-- Element (condition)
......@@ -362,7 +359,6 @@ package SCOs is
-- C2 = 'c', 't', or 'f' (condition/true/false)
-- From = starting source location
-- To = ending source location
-- Node = Empty
-- Last = False for all but the last entry, True for last entry
-- Note: the sequence starting with a decision, and continuing with
......@@ -415,7 +411,6 @@ package SCOs is
To : Source_Location := No_Source_Location;
C1 : Character := ' ';
C2 : Character := ' ';
Node : Node_Id := Empty;
Last : Boolean := False);
-- Adds one entry to SCO table with given field values
......
gcc/ada/sem_ch12.adb
......@@ -12223,6 +12223,25 @@ package body Sem_Ch12 is
-- All other cases than aggregates
else
-- For pragmas, we propagate the Enabled status for the
-- relevant pragmas to the original generic tree. This was
-- originally needed for SCO generation. It is no longer
-- needed there (since we use the Sloc value in calls to
-- Set_SCO_Pragma_Enabled), but it seems a generally good
-- idea to have this flag set properly.
if Nkind (N) = N_Pragma
and then
(Pragma_Name (N) = Name_Precondition
or else Pragma_Name (N) = Name_Postcondition)
and then Present (Associated_Node (Pragma_Identifier (N)))
then
Set_Pragma_Enabled (N,
Pragma_Enabled
(Parent (Associated_Node (Pragma_Identifier (N)))));
end if;
Save_Global_Descendant (Field1 (N));
Save_Global_Descendant (Field2 (N));
Save_Global_Descendant (Field3 (N));
......
gcc/ada/sem_prag.adb
......@@ -46,6 +46,7 @@ with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
with Output; use Output;
with Par_SCO; use Par_SCO;
with Restrict; use Restrict;
with Rident; use Rident;
with Rtsfind; use Rtsfind;
......@@ -1393,9 +1394,12 @@ package body Sem_Prag is
Pragma_Misplaced;
end if;
-- Record whether pragma is enabled
-- Record if pragma is enabled
Set_Pragma_Enabled (N, Check_Enabled (Pname));
if Check_Enabled (Pname) then
Set_Pragma_Enabled (N);
Set_SCO_Pragma_Enabled (Loc);
end if;
-- If we are within an inlined body, the legality of the pragma
-- has been checked already.
......@@ -5776,8 +5780,12 @@ package body Sem_Prag is
-- is to deal with pragma Assert rewritten as a Check pragma.
Check_On := Check_Enabled (Chars (Get_Pragma_Arg (Arg1)));
Set_Pragma_Enabled (N, Check_On);
Set_Pragma_Enabled (Original_Node (N), Check_On);
if Check_On then
Set_Pragma_Enabled (N);
Set_Pragma_Enabled (Original_Node (N));
Set_SCO_Pragma_Enabled (Loc);
end if;
-- If expansion is active and the check is not enabled then we
-- rewrite the Check as:
......
gcc/ada/switch-c.adb
......@@ -23,7 +23,6 @@
-- --
------------------------------------------------------------------------------
with Back_End; use Back_End;
with Debug; use Debug;
with Lib; use Lib;
with Osint; use Osint;
......@@ -39,14 +38,57 @@ with System.WCh_Con; use System.WCh_Con;
package body Switch.C is
type Arg_Array is array (Nat) of Big_String_Ptr;
type Arg_Array_Ptr is access Arg_Array;
-- Types to access compiler arguments
save_argc : Nat;
pragma Import (C, save_argc);
-- Saved value of argc (number of arguments), imported from toplev.c
save_argv : Arg_Array_Ptr;
pragma Import (C, save_argv);
-- Saved value of argv (argument pointers), imported from toplev.c
RTS_Specified : String_Access := null;
-- Used to detect multiple use of --RTS= flag
function Len_Arg (Arg : Pos) return Nat;
-- Determine length of argument number Arg on original gnat1 command line
function Switch_Subsequently_Cancelled
(C : String;
Arg_Rank : Pos)
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.
-------------
-- Len_Arg --
-------------
function Len_Arg (Arg : Pos) return Nat is
begin
for J in 1 .. Nat'Last loop
if save_argv (Arg).all (Natural (J)) = ASCII.NUL then
return J - 1;
end if;
end loop;
raise Program_Error;
end Len_Arg;
-----------------------------
-- Scan_Front_End_Switches --
-----------------------------
procedure Scan_Front_End_Switches (Switch_Chars : String) is
procedure Scan_Front_End_Switches
(Switch_Chars : String;
Arg_Rank : Pos)
is
First_Switch : Boolean := True;
-- False for all but first switch
......@@ -665,7 +707,7 @@ package body Switch.C is
-- Skip processing if cancelled by subsequent -gnat-p
if Switch_Subsequently_Cancelled ("p") then
if Switch_Subsequently_Cancelled ("p", Arg_Rank) then
Store_Switch := False;
else
......@@ -1078,4 +1120,35 @@ package body Switch.C is
end if;
end Scan_Front_End_Switches;
-----------------------------------
-- Switch_Subsequently_Cancelled --
-----------------------------------
function Switch_Subsequently_Cancelled
(C : String;
Arg_Rank : Pos)
return Boolean
is
Arg : Pos;
begin
Arg := Arg_Rank + 1;
while Arg < save_argc loop
declare
Argv_Ptr : constant Big_String_Ptr := save_argv (Arg);
Argv_Len : constant Nat := Len_Arg (Arg);
Argv : constant String :=
Argv_Ptr (1 .. Natural (Argv_Len));
begin
if Argv = "-gnat-" & C then
return True;
end if;
end;
Arg := Arg + 1;
end loop;
return False;
end Switch_Subsequently_Cancelled;
end Switch.C;
gcc/ada/switch-c.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2007, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2009, 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- --
......@@ -31,13 +31,18 @@
package Switch.C is
procedure Scan_Front_End_Switches (Switch_Chars : String);
procedure Scan_Front_End_Switches
(Switch_Chars : String;
Arg_Rank : Pos);
-- Procedures to scan out front end switches stored in the given string.
-- The first character is known to be a valid switch character, and there
-- are no blanks or other switch terminator characters in the string, so
-- the entire string should consist of valid switch characters, except that
-- an optional terminating NUL character is allowed. A bad switch causes
-- a fatal error exit and control does not return. The call also sets
-- Usage_Requested to True if a ? switch is encountered.
-- Usage_Requested to True if a switch -gnath is encountered.
-- Arg_Rank is the position of the switch in the command line arguments.
-- It is used for certain switches -gnatx to check if a subsequent switch
-- -gnat-x cancels the switch -gnatx.
end Switch.C;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment