Skip to content

R
riscv-gcc-1
Commit 06ad40d3 by Arnaud Charlet
Options

[multiple changes] 

2012-12-05  Thomas Quinot  <quinot@adacore.com>

	* par_sco.adb, scos.ads, put_scos.adb, put_scos.ads,
	get_scos.adb: Generation of SCOs for aspects.

2012-12-05  Thomas Quinot  <quinot@adacore.com>

	* sem_prag.adb (Check_Precondition_Postcondition): Remove
	redundant call to Set_SCO_Pragma_Enabled (the pragma will be
	rewritten into a pragma Check later on, and the call will be
	made when processing the rewritten pragma).
	(Analyze_Pragma, case Pragma_Check): Omit call to
	Set_SCO_Pragma_Enabled if Split_PPC is set.

2012-12-05  Olivier Hainque  <hainque@adacore.com>

	* tracebak.c: Add partial support for Lynx178.

2012-12-05  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_attr.adb (Analyze_Attribute): Improve
	the error message related to loop assertions.

2012-12-05  Gary Dismukes  <dismukes@adacore.com>

	* atree.ads: Minor reformatting.

From-SVN: r194211
parent af31bd57
Showing with 167 additions and 112 deletions
gcc/ada/ChangeLog
2012-12-05 Thomas Quinot <quinot@adacore.com>
* par_sco.adb, scos.ads, put_scos.adb, put_scos.ads,
get_scos.adb: Generation of SCOs for aspects.
2012-12-05 Thomas Quinot <quinot@adacore.com>
* sem_prag.adb (Check_Precondition_Postcondition): Remove
redundant call to Set_SCO_Pragma_Enabled (the pragma will be
rewritten into a pragma Check later on, and the call will be
made when processing the rewritten pragma).
(Analyze_Pragma, case Pragma_Check): Omit call to
Set_SCO_Pragma_Enabled if Split_PPC is set.
2012-12-05 Olivier Hainque <hainque@adacore.com>
* tracebak.c: Add partial support for Lynx178.
2012-12-05 Hristian Kirtchev <kirtchev@adacore.com>
* sem_attr.adb (Analyze_Attribute): Improve
the error message related to loop assertions.
2012-12-05 Gary Dismukes <dismukes@adacore.com>
* atree.ads: Minor reformatting.
2012-12-05 Robert Dewar <dewar@adacore.com>
* atree.ads, par-ch4.adb, sem_attr.adb, sem_ch13.adb: Minor
......
gcc/ada/atree.ads
......@@ -107,7 +107,7 @@ package Atree is
-- Note: the required parentheses surrounding conditional
-- and quantified expressions count as a level of parens
-- for this purposes, so e.g. in X := (if A then B else C);
-- for this purpose, so e.g. in X := (if A then B else C);
-- Paren_Count for the right side will be 1.
-- Comes_From_Source
......
gcc/ada/get_scos.adb
......@@ -28,8 +28,8 @@ pragma Ada_2005;
-- read SCO information from ALI files (Xcov and sco_test). Ada 2005
-- constructs may therefore be used freely (and are indeed).
with Namet; use Namet;
with SCOs; use SCOs;
with Snames; use Snames;
with Types; use Types;
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
......@@ -203,6 +203,8 @@ procedure Get_SCOs is
N : Natural;
-- Scratch buffer, and index into it
Nam : Name_Id;
-- Start of processing for Get_Scos
begin
......@@ -308,7 +310,6 @@ begin
declare
Typ : Character;
Key : Character;
Pid : Pragma_Id;
begin
Key := 'S';
......@@ -327,7 +328,7 @@ begin
-- Loop through items on one line
loop
Pid := Unknown_Pragma;
Nam := No_Name;
Typ := Nextc;
case Typ is
......@@ -348,25 +349,16 @@ begin
Skipc;
if Typ = 'P' or else Typ = 'p' then
if Nextc not in '1' .. '9' then
N := 1;
Name_Len := 0;
loop
Buf (N) := Getc;
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Getc;
exit when Nextc = ':';
N := N + 1;
end loop;
Skipc;
begin
Pid :=
Pragma_Id'Value ("pragma_" & Buf (1 .. N));
exception
when Constraint_Error =>
Skipc; -- Past ':'
-- Pid remains set to Unknown_Pragma
null;
end;
Nam := Name_Find;
end if;
end if;
end case;
......@@ -379,13 +371,13 @@ begin
end if;
SCO_Table.Append
((C1 => Key,
C2 => Typ,
From => Loc1,
To => Loc2,
Last => At_EOL,
Pragma_Sloc => No_Location,
Pragma_Name => Pid));
((C1 => Key,
C2 => Typ,
From => Loc1,
To => Loc2,
Last => At_EOL,
Pragma_Sloc => No_Location,
Pragma_Aspect_Name => Nam));
if Key = '>' then
Key := 'S';
......@@ -397,8 +389,21 @@ begin
-- Decision entry
when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' | 'A' =>
Dtyp := C;
if C = 'A' then
Name_Len := 0;
while Nextc /= ' ' loop
Name_Len := Name_Len + 1;
Name_Buffer (Name_Len) := Getc;
end loop;
Nam := Name_Find;
else
Nam := No_Name;
end if;
Skip_Spaces;
-- Output header
......@@ -416,12 +421,13 @@ begin
end if;
SCO_Table.Append
((C1 => Dtyp,
C2 => ' ',
From => Loc,
To => No_Source_Location,
Last => False,
others => <>));
((C1 => Dtyp,
C2 => ' ',
From => Loc,
To => No_Source_Location,
Last => False,
Pragma_Aspect_Name => Nam,
others => <>));
end;
-- Loop through terms in complex expression
......
gcc/ada/put_scos.adb
......@@ -23,10 +23,9 @@
-- --
------------------------------------------------------------------------------
with Namet; use Namet;
with Opt; use Opt;
with Par_SCO; use Par_SCO;
with SCOs; use SCOs;
with Snames; use Snames;
procedure Put_SCOs is
Current_SCO_Unit : SCO_Unit_Index := 0;
......@@ -195,18 +194,10 @@ begin
if Sent.C1 = 'S'
and then (Sent.C2 = 'P' or else Sent.C2 = 'p')
and then Sent.Pragma_Name /= Unknown_Pragma
and then Sent.Pragma_Aspect_Name /= No_Name
then
-- Strip leading "PRAGMA_"
declare
Pnam : constant String :=
Sent.Pragma_Name'Img;
begin
Output_String
(Pnam (Pnam'First + 7 .. Pnam'Last));
Write_Info_Char (':');
end;
Write_Info_Name (Sent.Pragma_Aspect_Name);
Write_Info_Char (':');
end if;
end if;
......@@ -240,57 +231,55 @@ begin
-- Decision
when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' =>
when 'E' | 'G' | 'I' | 'P' | 'W' | 'X' | 'A' =>
Start := Start + 1;
-- For disabled pragma, or nested decision therein, skip
-- decision output.
Write_SCO_Initiate (U);
Write_Info_Char (T.C1);
if SCO_Pragma_Disabled (T.Pragma_Sloc) then
while not SCO_Table.Table (Start).Last loop
Start := Start + 1;
end loop;
if T.C1 = 'A' then
Write_Info_Name (T.Pragma_Aspect_Name);
end if;
if T.C1 /= 'X' then
Write_Info_Char (' ');
Output_Source_Location (T.From);
end if;
-- For all other cases output decision line
-- Loop through table entries for this decision
else
Write_SCO_Initiate (U);
Write_Info_Char (T.C1);
loop
declare
T : SCO_Table_Entry
renames SCO_Table.Table (Start);
if T.C1 /= 'X' then
begin
Write_Info_Char (' ');
Output_Source_Location (T.From);
end if;
-- Loop through table entries for this decision
if T.C1 = '!' or else
T.C1 = '&' or else
T.C1 = '|'
then
Write_Info_Char (T.C1);
Output_Source_Location (T.From);
loop
declare
T : SCO_Table_Entry
renames SCO_Table.Table (Start);
else
Write_Info_Char (T.C2);
Output_Range (T);
end if;
begin
Write_Info_Char (' ');
exit when T.Last;
Start := Start + 1;
end;
end loop;
if T.C1 = '!' or else
T.C1 = '&' or else
T.C1 = '|'
then
Write_Info_Char (T.C1);
Output_Source_Location (T.From);
Write_Info_Terminate;
else
Write_Info_Char (T.C2);
Output_Range (T);
end if;
when ASCII.NUL =>
exit when T.Last;
Start := Start + 1;
end;
end loop;
-- Nullified entry: skip
Write_Info_Terminate;
end if;
null;
when others =>
raise Program_Error;
......
gcc/ada/put_scos.ads
......@@ -2,11 +2,11 @@
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- P U T _ S C O S --
-- P U T _ S C O S --
-- --
-- S p e c --
-- --
-- Copyright (C) 2009, Free Software Foundation, Inc. --
-- Copyright (C) 2009-2012, 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- --
......@@ -28,6 +28,7 @@
-- the ALI file. The interface allows control over the destination of the
-- output, so that this routine can also be used for debugging purposes.
with Namet; use Namet;
with Types; use Types;
generic
......@@ -43,6 +44,9 @@ generic
-- Initiates write of new line to output file, the parameter is the
-- keyword character for the line.
with procedure Write_Info_Name (Nam : Name_Id) is <>;
-- Outputs one name
with procedure Write_Info_Nat (N : Nat) is <>;
-- Writes image of N to output file with no leading or trailing blanks
......
gcc/ada/scos.ads
......@@ -28,11 +28,8 @@
-- the ALI file, and by Get_SCO/Put_SCO to read and write the text form that
-- is used in the ALI file.
with Snames; use Snames;
-- Note: used for Pragma_Id only, no other feature from Snames should be used,
-- as a simplified version is maintained in Xcov.
with Types; use Types;
with Namet; use Namet;
with Types; use Types;
with GNAT.Table;
......@@ -248,18 +245,21 @@ package SCOs is
-- C* sloc expression
-- Here * is one of the following characters:
-- Here * is one of the following:
-- E decision in EXIT WHEN statement
-- G decision in entry guard
-- I decision in IF statement or if expression
-- P decision in pragma Assert/Check/Pre_Condition/Post_Condition
-- W decision in WHILE iteration scheme
-- X decision appearing in some other expression context
-- E decision in EXIT WHEN statement
-- G decision in entry guard
-- I decision in IF statement or if expression
-- P decision in pragma Assert / Check / Pre/Post_Condition
-- A[name] decision in aspect Pre/Post (aspect name optional)
-- W decision in WHILE iteration scheme
-- X decision in some other expression context
-- For E, G, I, P, W, sloc is the source location of the EXIT, ENTRY, IF,
-- PRAGMA or WHILE token, respectively
-- For A sloc is the source location of the aspect identifier
-- For X, sloc is omitted
-- The expression is a prefix polish form indicating the structure of
......@@ -369,10 +369,12 @@ package SCOs is
Pragma_Sloc : Source_Ptr := No_Location;
-- For the statement SCO for a pragma, or for any expression SCO nested
-- in a pragma Debug/Assert/PPC, location of PRAGMA token (used for
-- control of SCO output, value not recorded in ALI file).
-- control of SCO output, value not recorded in ALI file). For the
-- decision SCO for an aspect, or for any expression SCO nested in an
-- aspect, location of aspect identifier token (likewise).
Pragma_Name : Pragma_Id := Unknown_Pragma;
-- For the statement SCO for a pragma, gives the pragma name
Pragma_Aspect_Name : Name_Id := No_Name;
-- For the SCO for a pragma/aspect, gives the pragma/apsect name
end record;
package SCO_Table is new GNAT.Table (
......@@ -382,6 +384,11 @@ package SCOs is
Table_Initial => 500,
Table_Increment => 300);
Is_Decision : constant array (Character) of Boolean :=
('E' | 'G' | 'I' | 'P' | 'A' | 'W' | 'X' => True,
others => False);
-- Indicates which C1 values correspond to decisions
-- The SCO_Table_Entry values appear as follows:
-- Statements
......@@ -432,7 +439,20 @@ package SCOs is
-- SCO contexts, the only pragmas with decisions are Assert, Check,
-- dyadic Debug, Precondition and Postcondition). These entries will
-- be omitted in output if the pragma is disabled (see comments for
-- statement entries).
-- statement entries). This is achieved by setting C1 to NUL for all
-- SCO entries of the decision.
-- Decision (ASPECT)
-- C1 = 'A'
-- C2 = ' '
-- From = aspect identifier
-- To = No_Source_Location
-- Last = unused
-- Note: when the parse tree is first scanned, we unconditionally build a
-- pragma decision entry for any decision in an aspect (Pre/Post/
-- [Type_]Invariant/[Static_|Dynamic_]Predicate). Entries for disabled
-- Pre/Post aspects will be omitted from output.
-- Decision (Expression)
-- C1 = 'X'
......
gcc/ada/sem_attr.adb
......@@ -3847,7 +3847,8 @@ package body Sem_Attr is
if not In_Loop_Assertion then
Error_Attr
("attribute % must appear within pragma Loop_Assertion", N);
("attribute % must appear within pragma Loop_Variant or " &
"Loop_Invariant", N);
end if;
-- A Loop_Entry that applies to a given loop statement shall not
......
gcc/ada/sem_prag.adb
......@@ -2181,13 +2181,6 @@ package body Sem_Prag is
(Get_Pragma_Arg (Arg2), Standard_String);
end if;
-- For a pragma in the extended main source unit, record enabled
-- status in SCO (note: there is never any SCO for an instance).
if Check_Enabled (Pname) then
Set_SCO_Pragma_Enabled (Loc);
end if;
-- If we are within an inlined body, the legality of the pragma
-- has been checked already.
......@@ -7407,7 +7400,7 @@ package body Sem_Prag is
Check_On := Check_Enabled (Chars (Get_Pragma_Arg (Arg1)));
if Check_On then
if Check_On and then not Split_PPC (N) then
Set_SCO_Pragma_Enabled (Loc);
end if;
......
gcc/ada/tracebak.c
......@@ -287,9 +287,10 @@ __gnat_backtrace (void **array,
#error Unhandled darwin architecture.
#endif
/*------------------------ PPC AIX/Older Darwin -------------------------*/
/*---------------------- PPC AIX/PPC Lynx 178/Older Darwin ------------------*/
#elif ((defined (_POWER) && defined (_AIX)) || \
(defined (__ppc__) && defined (__APPLE__)))
(defined (__powerpc__) && defined (__Lynx__) && !defined(__ELF__)) || \
(defined (__ppc__) && defined (__APPLE__)))
#define USE_GENERIC_UNWINDER
......@@ -307,9 +308,23 @@ struct layout
should to feature a null backchain, AIX might expose a null return
address instead. */
/* Then LynxOS-178 features yet another variation, with return_address
== &__start, which we only add conditionally as this symbol is not
necessarily present elsewhere. Beware that &bla returns the
address of a descriptor when "bla" is a function. Getting the code
address requires an extra dereference. */
#if defined (__Lynx__)
extern void __start();
#define EXTRA_STOP_CONDITION(CURRENT) ((CURRENT)->return_address == *(void**)&__start)
#else
#define EXTRA_STOP_CONDITION(CURRENT) (0)
#endif
#define STOP_FRAME(CURRENT, TOP_STACK) \
(((void *) (CURRENT) < (TOP_STACK)) \
|| (CURRENT)->return_address == NULL)
|| (CURRENT)->return_address == NULL \
|| EXTRA_STOP_CONDITION(CURRENT))
/* The PPC ABI has an interesting specificity: the return address saved by a
function is located in it's caller's frame, and the save operation only
......
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