Skip to content

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

[multiple changes] 

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* stand.adb (Tree_Read): Read missing entities.
	(Tree_Write): Write missing entities.

2014-05-21  Ben Brosgol  <brosgol@adacore.com>

	* gnat_ugn.texi: Wordsmithing edits to Coupling Metrics Control
	section in gnatmetric chapter.

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* exp_ch6.adb (Expand_Actuals): Spec moved here, since not used
	outside Exp_Ch6 (Expand_Actuals): Deal with proper insertion of
	post-call copy write back (see detailed comment in code).
	* exp_ch6.ads (Expand_Actuals): Moved to body, not used outside
	Exp_Ch6.
	* tbuild.ads: Minor reformatting.

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* stand.ads: Add warning about adding new entities and
	Tree_Read/Tree_Write.

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* sem_util.adb (Set_Entity_With_Checks): Don't complain about
	references to restricted entities within the units in which they
	are declared.

2014-05-21  Robert Dewar  <dewar@adacore.com>

	* gnat1drv.adb (Check_Bad_Body): Use Source_File_Is_Body to
	simplify the needed test, and also deal with failure to catch
	situations with non-standard names.
	* sinput-l.ads, sinput-l.adb (Source_File_Is_No_Body): New function
	(Source_File_Is_Subunit): Removed, no longer used.

2014-05-21  Javier Miranda  <miranda@adacore.com>

	* exp_ch4.adb
	(Expand_Allocator_Expression.Apply_Accessibility_Check): for a
	renaming of an access to interface object there is no need to
	generate extra code to reference the tag.

From-SVN: r210696
parent 77a40ec1
Showing with 382 additions and 130 deletions
gcc/ada/ChangeLog
2014-05-21 Robert Dewar <dewar@adacore.com>
* stand.adb (Tree_Read): Read missing entities.
(Tree_Write): Write missing entities.
2014-05-21 Ben Brosgol <brosgol@adacore.com>
* gnat_ugn.texi: Wordsmithing edits to Coupling Metrics Control
section in gnatmetric chapter.
2014-05-21 Robert Dewar <dewar@adacore.com>
* exp_ch6.adb (Expand_Actuals): Spec moved here, since not used
outside Exp_Ch6 (Expand_Actuals): Deal with proper insertion of
post-call copy write back (see detailed comment in code).
* exp_ch6.ads (Expand_Actuals): Moved to body, not used outside
Exp_Ch6.
* tbuild.ads: Minor reformatting.
2014-05-21 Robert Dewar <dewar@adacore.com>
* stand.ads: Add warning about adding new entities and
Tree_Read/Tree_Write.
2014-05-21 Robert Dewar <dewar@adacore.com>
* sem_util.adb (Set_Entity_With_Checks): Don't complain about
references to restricted entities within the units in which they
are declared.
2014-05-21 Robert Dewar <dewar@adacore.com>
* gnat1drv.adb (Check_Bad_Body): Use Source_File_Is_Body to
simplify the needed test, and also deal with failure to catch
situations with non-standard names.
* sinput-l.ads, sinput-l.adb (Source_File_Is_No_Body): New function
(Source_File_Is_Subunit): Removed, no longer used.
2014-05-21 Javier Miranda <miranda@adacore.com>
* exp_ch4.adb
(Expand_Allocator_Expression.Apply_Accessibility_Check): for a
renaming of an access to interface object there is no need to
generate extra code to reference the tag.
2014-05-21 Robert Dewar <dewar@adacore.com>
* errout.adb, erroutc.adb, erroutc.ads: Allow warning tag in pragma
Warnings (Off, string).
......
gcc/ada/exp_ch4.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
......@@ -831,13 +831,25 @@ package body Exp_Ch4 is
-- Step 2: Create the accessibility comparison
-- Reference the tag: for a renaming of an access to an interface
-- object Obj_Ref already references the tag of the secondary
-- dispatch table.
if Present (Parent (Entity (Obj_Ref)))
and then Present (Renamed_Object (Entity (Obj_Ref)))
and then Is_Interface (DesigT)
then
null;
-- Generate:
-- Ref'Tag
Obj_Ref :=
Make_Attribute_Reference (Loc,
Prefix => Obj_Ref,
Attribute_Name => Name_Tag);
else
Obj_Ref :=
Make_Attribute_Reference (Loc,
Prefix => Obj_Ref,
Attribute_Name => Name_Tag);
end if;
-- For tagged types, determine the accessibility level by looking
-- at the type specific data of the dispatch table. Generate:
......
gcc/ada/exp_ch6.adb
......@@ -165,6 +165,41 @@ package body Exp_Ch6 is
-- the values are not changed for the call, we know immediately that
-- we have an infinite recursion.
procedure Expand_Actuals (N : in out Node_Id; Subp : Entity_Id);
-- For each actual of an in-out or out parameter which is a numeric
-- (view) conversion of the form T (A), where A denotes a variable,
-- we insert the declaration:
--
-- Temp : T[ := T (A)];
--
-- prior to the call. Then we replace the actual with a reference to Temp,
-- and append the assignment:
--
-- A := TypeA (Temp);
--
-- after the call. Here TypeA is the actual type of variable A. For out
-- parameters, the initial declaration has no expression. If A is not an
-- entity name, we generate instead:
--
-- Var : TypeA renames A;
-- Temp : T := Var; -- omitting expression for out parameter.
-- ...
-- Var := TypeA (Temp);
--
-- For other in-out parameters, we emit the required constraint checks
-- before and/or after the call.
--
-- For all parameter modes, actuals that denote components and slices of
-- packed arrays are expanded into suitable temporaries.
--
-- For non-scalar objects that are possibly unaligned, add call by copy
-- code (copy in for IN and IN OUT, copy out for OUT and IN OUT).
--
-- The parameter N is IN OUT because in some cases, the expansion code
-- rewrites the call as an expression actions with the call inside. In
-- this case N is reset to point to the inside call so that the caller
-- can continue processing of this call.
procedure Expand_Ctrl_Function_Call (N : Node_Id);
-- N is a function call which returns a controlled object. Transform the
-- call into a temporary which retrieves the returned object from the
......@@ -939,7 +974,7 @@ package body Exp_Ch6 is
-- Expand_Actuals --
--------------------
procedure Expand_Actuals (N : Node_Id; Subp : Entity_Id) is
procedure Expand_Actuals (N : in out Node_Id; Subp : Entity_Id) is
Loc : constant Source_Ptr := Sloc (N);
Actual : Node_Id;
Formal : Entity_Id;
......@@ -976,10 +1011,10 @@ package body Exp_Ch6 is
-- the effect that this might lead to unaligned arguments.
function Make_Var (Actual : Node_Id) return Entity_Id;
-- Returns an entity that refers to the given actual parameter,
-- Actual (not including any type conversion). If Actual is an
-- entity name, then this entity is returned unchanged, otherwise
-- a renaming is created to provide an entity for the actual.
-- Returns an entity that refers to the given actual parameter, Actual
-- (not including any type conversion). If Actual is an entity name,
-- then this entity is returned unchanged, otherwise a renaming is
-- created to provide an entity for the actual.
procedure Reset_Packed_Prefix;
-- The expansion of a packed array component reference is delayed in
......@@ -1604,8 +1639,8 @@ package body Exp_Ch6 is
-- Also pass by copy if change of representation
or else not Same_Representation
(Etype (Formal),
Etype (Expression (Actual))))
(Etype (Formal),
Etype (Expression (Actual))))
then
Add_Call_By_Copy_Code;
......@@ -1809,7 +1844,7 @@ package body Exp_Ch6 is
if In_Open_Scopes (Entity (Actual)) then
Rewrite (Actual,
(Make_Function_Call (Loc,
Name => New_Occurrence_Of (RTE (RE_Self), Loc))));
Name => New_Occurrence_Of (RTE (RE_Self), Loc))));
Analyze (Actual);
-- A task type cannot otherwise appear as an actual
......@@ -1831,36 +1866,93 @@ package body Exp_Ch6 is
-- Cases where the call is not a member of a statement list
if not Is_List_Member (N) then
declare
P : Node_Id := Parent (N);
begin
-- In Ada 2012 the call may be a function call in an expression
-- (since OUT and IN OUT parameters are now allowed for such
-- calls. The write-back of (in)-out parameters is handled
-- by the back-end, but the constraint checks generated when
-- subtypes of formal and actual don't match must be inserted
-- in the form of assignments, at the nearest point after the
-- declaration or statement that contains the call.
if Ada_Version >= Ada_2012
and then Nkind (N) = N_Function_Call
then
while Nkind (P) not in N_Declaration
and then
Nkind (P) not in N_Statement_Other_Than_Procedure_Call
loop
P := Parent (P);
end loop;
-- In Ada 2012 the call may be a function call in an expression
-- (since OUT and IN OUT parameters are now allowed for such
-- calls). The write-back of (in)-out parameters is handled
-- by the back-end, but the constraint checks generated when
-- subtypes of formal and actual don't match must be inserted
-- in the form of assignments.
Insert_Actions_After (P, Post_Call);
if Ada_Version >= Ada_2012
and then Nkind (N) = N_Function_Call
then
-- We used to just do handle this by climbing up parents to
-- a non-statement/declaration and then simply making a call
-- to Insert_Actions_After (P, Post_Call), but that doesn't
-- work. If we are in the middle of an expression, e.g. the
-- condition of an IF, this call would insert after the IF
-- statement, which is much too late to be doing the write
-- back. For example:
-- if Clobber (X) then
-- Put_Line (X'Img);
-- else
-- goto Junk
-- end if;
-- Now assume Clobber changes X, if we put the write back
-- after the IF, the Put_Line gets the wrong value and the
-- goto causes the write back to be skipped completely.
-- To deal with this, we replace the call by
-- do
-- Tnnn : function-result-type renames function-call;
-- Post_Call actions
-- in
-- Tnnn;
-- end;
-- Note: this won't do in Modify_Tree_For_C mode, but we
-- will deal with that later (it will require creating a
-- declaration for Temp, using Insert_Declaration) ???
-- If not the special Ada 2012 case of a function call, then
-- we must have the triggering statement of a triggering
-- alternative or an entry call alternative, and we can add
-- the post call stuff to the corresponding statement list.
declare
Tnnn : constant Entity_Id := Make_Temporary (Loc, 'T');
FRTyp : constant Entity_Id := Etype (N);
Name : constant Node_Id := Relocate_Node (N);
else
begin
Prepend_To (Post_Call,
Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Tnnn,
Subtype_Mark => New_Occurrence_Of (FRTyp, Loc),
Name => Name));
Rewrite (N,
Make_Expression_With_Actions (Loc,
Actions => Post_Call,
Expression => New_Occurrence_Of (Tnnn, Loc)));
-- We don't want to just blindly call Analyze_And_Resolve
-- because that would cause unwanted recursion on the call.
-- So for a moment set the call as analyzed to prevent that
-- recursion, and get the rest analyzed properly, then reset
-- the analyzed flag, so our caller can continue.
Set_Analyzed (Name, True);
Analyze_And_Resolve (N, FRTyp);
Set_Analyzed (Name, False);
-- Reset calling argument to point to function call inside
-- the expression with actions so the caller can continue
-- to process the call.
N := Name;
end;
-- If not the special Ada 2012 case of a function call, then
-- we must have the triggering statement of a triggering
-- alternative or an entry call alternative, and we can add
-- the post call stuff to the corresponding statement list.
else
declare
P : Node_Id;
begin
P := Parent (N);
pragma Assert (Nkind_In (P, N_Triggering_Alternative,
N_Entry_Call_Alternative));
......@@ -1870,15 +1962,17 @@ package body Exp_Ch6 is
else
Set_Statements (P, Post_Call);
end if;
end if;
end;
return;
end;
end if;
-- Otherwise, normal case where N is in a statement sequence,
-- just put the post-call stuff after the call statement.
else
Insert_Actions_After (N, Post_Call);
return;
end if;
end if;
......
gcc/ada/exp_ch6.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
......@@ -37,36 +37,6 @@ package Exp_Ch6 is
procedure Expand_N_Subprogram_Body_Stub (N : Node_Id);
procedure Expand_N_Subprogram_Declaration (N : Node_Id);
procedure Expand_Actuals (N : Node_Id; Subp : Entity_Id);
-- For each actual of an in-out or out parameter which is a numeric
-- (view) conversion of the form T (A), where A denotes a variable,
-- we insert the declaration:
--
-- Temp : T[ := T (A)];
--
-- prior to the call. Then we replace the actual with a reference to Temp,
-- and append the assignment:
--
-- A := TypeA (Temp);
--
-- after the call. Here TypeA is the actual type of variable A. For out
-- parameters, the initial declaration has no expression. If A is not an
-- entity name, we generate instead:
--
-- Var : TypeA renames A;
-- Temp : T := Var; -- omitting expression for out parameter.
-- ...
-- Var := TypeA (Temp);
--
-- For other in-out parameters, we emit the required constraint checks
-- before and/or after the call.
--
-- For all parameter modes, actuals that denote components and slices of
-- packed arrays are expanded into suitable temporaries.
--
-- For non-scalar objects that are possibly unaligned, add call by copy
-- code (copy in for IN and IN OUT, copy out for OUT and IN OUT).
procedure Expand_Call (N : Node_Id);
-- This procedure contains common processing for Expand_N_Function_Call,
-- Expand_N_Procedure_Statement, and Expand_N_Entry_Call.
......
gcc/ada/gnat1drv.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
......@@ -633,7 +633,6 @@ procedure Gnat1drv is
Sname := Unit_Name (Main_Unit);
-- If we do not already have a body name, then get the body name
-- (but how can we have a body name here???)
if not Is_Body_Name (Sname) then
Sname := Get_Body_Name (Sname);
......@@ -651,19 +650,15 @@ procedure Gnat1drv is
-- to include both in a partition, this is diagnosed at bind time. In
-- Ada 83 mode this is not a warning case.
-- Note: if weird file names are being used, we can have a situation
-- where the file name that supposedly contains body in fact contains
-- a spec, or we can't tell what it contains. Skip the error message
-- in these cases.
-- Also ignore body that is nothing but pragma No_Body; (that's the
-- whole point of this pragma, to be used this way and to cause the
-- body file to be ignored in this context).
-- Note that in general we do not give the message if the file in
-- question does not look like a body. This includes weird cases,
-- but in particular means that if the file is just a No_Body pragma,
-- then we won't give the message (that's the whole point of this
-- pragma, to be used this way and to cause the body file to be
-- ignored in this context).
if Src_Ind /= No_Source_File
and then Get_Expected_Unit_Type (Fname) = Expect_Body
and then not Source_File_Is_Subunit (Src_Ind)
and then not Source_File_Is_No_Body (Src_Ind)
and then Source_File_Is_Body (Src_Ind)
then
Errout.Finalize (Last_Call => False);
......@@ -693,8 +688,8 @@ procedure Gnat1drv is
else
-- For generic instantiations, we never allow a body
if Nkind (Original_Node (Unit (Main_Unit_Node)))
in N_Generic_Instantiation
if Nkind (Original_Node (Unit (Main_Unit_Node))) in
N_Generic_Instantiation
then
Bad_Body_Error
("generic instantiation for $$ does not allow a body");
......
gcc/ada/sem_util.adb
......@@ -15877,6 +15877,11 @@ package body Sem_Util is
if Restriction_Check_Required (No_Abort_Statements)
and then (Is_RTE (Val, RE_Abort_Task))
-- A special extra check, don't complain about a reference from within
-- the Ada.Task_Identification package itself!
and then not In_Same_Extended_Unit (N, Val)
then
Check_Restriction (No_Abort_Statements, Post_Node);
end if;
......@@ -15892,6 +15897,10 @@ package body Sem_Util is
Is_RTE (Val, RE_Exchange_Handler) or else
Is_RTE (Val, RE_Detach_Handler) or else
Is_RTE (Val, RE_Reference))
-- A special extra check, don't complain about a reference from within
-- the Ada.Interrupts package itself!
and then not In_Same_Extended_Unit (N, Val)
then
Check_Restriction (No_Dynamic_Attachment, Post_Node);
end if;
......
gcc/ada/sinput-l.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
......@@ -795,9 +795,106 @@ package body Sinput.L is
Prep_Buffer (Prep_Buffer_Last) := C;
end Put_Char_In_Prep_Buffer;
-----------------------------------
-- Source_File_Is_Pragma_No_Body --
-----------------------------------
-------------------------
-- Source_File_Is_Body --
-------------------------
function Source_File_Is_Body (X : Source_File_Index) return Boolean is
Pcount : Natural;
begin
Initialize_Scanner (No_Unit, X);
-- Loop to look for subprogram or package body
loop
case Token is
-- PRAGMA, WITH, USE (which can appear before a body)
when Tok_Pragma | Tok_With | Tok_Use =>
-- We just want to skip any of these, do it by skipping to a
-- semicolon, but check for EOF, in case we have bad syntax.
loop
if Token = Tok_Semicolon then
Scan;
exit;
elsif Token = Tok_EOF then
return False;
else
Scan;
end if;
end loop;
-- PACKAGE
when Tok_Package =>
Scan; -- Past PACKAGE
-- We have a body if and only if BODY follows
return Token = Tok_Body;
-- FUNCTION or PROCEDURE
when Tok_Procedure | Tok_Function =>
Pcount := 0;
-- Loop through tokens following PROCEDURE or FUNCTION
loop
Scan;
case Token is
-- For parens, count paren level (note that paren level
-- can get greater than 1 if we have default parameters).
when Tok_Left_Paren =>
Pcount := Pcount + 1;
when Tok_Right_Paren =>
Pcount := Pcount - 1;
-- EOF means something weird, probably no body
when Tok_EOF =>
return False;
-- BEGIN or IS or END definitely means body is present
when Tok_Begin | Tok_Is | Tok_End =>
return True;
-- Semicolon means no body present if at outside any
-- parens. If within parens, ignore, since it could be
-- a parameter separator.
when Tok_Semicolon =>
if Pcount = 0 then
return False;
end if;
-- Skip anything else
when others =>
null;
end case;
end loop;
-- Anything else in main scan means we don't have a body
when others =>
return False;
end case;
end loop;
end Source_File_Is_Body;
----------------------------
-- Source_File_Is_No_Body --
----------------------------
function Source_File_Is_No_Body (X : Source_File_Index) return Boolean is
begin
......@@ -826,27 +923,4 @@ package body Sinput.L is
return Token = Tok_EOF;
end Source_File_Is_No_Body;
----------------------------
-- Source_File_Is_Subunit --
----------------------------
function Source_File_Is_Subunit (X : Source_File_Index) return Boolean is
begin
Initialize_Scanner (No_Unit, X);
-- We scan past junk to the first interesting compilation unit token, to
-- see if it is SEPARATE. We ignore WITH keywords during this and also
-- PRIVATE. The reason for ignoring PRIVATE is that it handles some
-- error situations, and also to handle PRIVATE WITH in Ada 2005 mode.
while Token = Tok_With
or else Token = Tok_Private
or else (Token not in Token_Class_Cunit and then Token /= Tok_EOF)
loop
Scan;
end loop;
return Token = Tok_Separate;
end Source_File_Is_Subunit;
end Sinput.L;
gcc/ada/sinput-l.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
......@@ -64,19 +64,16 @@ package Sinput.L is
-- Called on completing the parsing of a source file. This call completes
-- the source file table entry for the current source file.
function Source_File_Is_Body (X : Source_File_Index) return Boolean;
-- Returns true if the designated source file contains a subprogram body
-- or a package body. This is a limited scan just to determine the answer
-- to this question..
function Source_File_Is_No_Body (X : Source_File_Index) return Boolean;
-- Returns true if the designated source file contains pragma No_Body;
-- and no other tokens. If the source file contains anything other than
-- this sequence of three tokens, then False is returned.
function Source_File_Is_Subunit (X : Source_File_Index) return Boolean;
-- This function determines if a source file represents a subunit. It
-- works by scanning for the first compilation unit token, and returning
-- True if it is the token SEPARATE. It will return False otherwise,
-- meaning that the file cannot possibly be a legal subunit. This
-- function does NOT do a complete parse of the file, or build a
-- tree. It is used in the main driver in the check for bad bodies.
-------------------------------------------------
-- Subprograms for Dealing With Instantiations --
-------------------------------------------------
......
gcc/ada/stand.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
......@@ -29,6 +29,7 @@
-- --
------------------------------------------------------------------------------
with Elists; use Elists;
with System; use System;
with Tree_IO; use Tree_IO;
......@@ -46,9 +47,32 @@ package body Stand is
Tree_Read_Int (Int (Standard_Package_Node));
Tree_Read_Int (Int (Last_Standard_Node_Id));
Tree_Read_Int (Int (Last_Standard_List_Id));
Tree_Read_Int (Int (Boolean_Literals (False)));
Tree_Read_Int (Int (Boolean_Literals (True)));
Tree_Read_Int (Int (Standard_Void_Type));
Tree_Read_Int (Int (Standard_Exception_Type));
Tree_Read_Int (Int (Standard_A_String));
Tree_Read_Int (Int (Standard_A_Char));
Tree_Read_Int (Int (Standard_Debug_Renaming_Type));
-- Deal with Predefined_Float_Types, which is an Elist. We wrote the
-- entities out in sequence, terminated by an Empty entry.
declare
Elmt : Entity_Id;
begin
Predefined_Float_Types := New_Elmt_List;
loop
Tree_Read_Int (Int (Elmt));
exit when Elmt = Empty;
Append_Elmt (Elmt, Predefined_Float_Types);
end loop;
end;
-- Remainder of special entities
Tree_Read_Int (Int (Any_Id));
Tree_Read_Int (Int (Any_Type));
Tree_Read_Int (Int (Any_Access));
......@@ -59,10 +83,12 @@ package body Stand is
Tree_Read_Int (Int (Any_Discrete));
Tree_Read_Int (Int (Any_Fixed));
Tree_Read_Int (Int (Any_Integer));
Tree_Read_Int (Int (Any_Modular));
Tree_Read_Int (Int (Any_Numeric));
Tree_Read_Int (Int (Any_Real));
Tree_Read_Int (Int (Any_Scalar));
Tree_Read_Int (Int (Any_String));
Tree_Read_Int (Int (Raise_Type));
Tree_Read_Int (Int (Universal_Integer));
Tree_Read_Int (Int (Universal_Real));
Tree_Read_Int (Int (Universal_Fixed));
......@@ -70,12 +96,12 @@ package body Stand is
Tree_Read_Int (Int (Standard_Integer_16));
Tree_Read_Int (Int (Standard_Integer_32));
Tree_Read_Int (Int (Standard_Integer_64));
Tree_Read_Int (Int (Standard_Unsigned_64));
Tree_Read_Int (Int (Standard_Short_Short_Unsigned));
Tree_Read_Int (Int (Standard_Short_Unsigned));
Tree_Read_Int (Int (Standard_Unsigned));
Tree_Read_Int (Int (Standard_Long_Unsigned));
Tree_Read_Int (Int (Standard_Long_Long_Unsigned));
Tree_Read_Int (Int (Standard_Unsigned_64));
Tree_Read_Int (Int (Abort_Signal));
Tree_Read_Int (Int (Standard_Op_Rotate_Left));
Tree_Read_Int (Int (Standard_Op_Rotate_Right));
......@@ -96,9 +122,34 @@ package body Stand is
Tree_Write_Int (Int (Standard_Package_Node));
Tree_Write_Int (Int (Last_Standard_Node_Id));
Tree_Write_Int (Int (Last_Standard_List_Id));
Tree_Write_Int (Int (Boolean_Literals (False)));
Tree_Write_Int (Int (Boolean_Literals (True)));
Tree_Write_Int (Int (Standard_Void_Type));
Tree_Write_Int (Int (Standard_Exception_Type));
Tree_Write_Int (Int (Standard_A_String));
Tree_Write_Int (Int (Standard_A_Char));
Tree_Write_Int (Int (Standard_Debug_Renaming_Type));
-- Deal with Predefined_Float_Types, which is an Elist. Write the
-- entities out in sequence, terminated by an Empty entry.
declare
Elmt : Elmt_Id;
begin
Elmt := First_Elmt (Predefined_Float_Types);
while Present (Elmt) loop
Tree_Write_Int (Int (Node (Elmt)));
Next_Elmt (Elmt);
end loop;
Tree_Write_Int (Int (Empty));
end;
-- Remainder of special entries
Tree_Write_Int (Int (Any_Id));
Tree_Write_Int (Int (Any_Type));
Tree_Write_Int (Int (Any_Access));
......@@ -109,10 +160,12 @@ package body Stand is
Tree_Write_Int (Int (Any_Discrete));
Tree_Write_Int (Int (Any_Fixed));
Tree_Write_Int (Int (Any_Integer));
Tree_Write_Int (Int (Any_Modular));
Tree_Write_Int (Int (Any_Numeric));
Tree_Write_Int (Int (Any_Real));
Tree_Write_Int (Int (Any_Scalar));
Tree_Write_Int (Int (Any_String));
Tree_Write_Int (Int (Raise_Type));
Tree_Write_Int (Int (Universal_Integer));
Tree_Write_Int (Int (Universal_Real));
Tree_Write_Int (Int (Universal_Fixed));
......@@ -120,12 +173,12 @@ package body Stand is
Tree_Write_Int (Int (Standard_Integer_16));
Tree_Write_Int (Int (Standard_Integer_32));
Tree_Write_Int (Int (Standard_Integer_64));
Tree_Write_Int (Int (Standard_Unsigned_64));
Tree_Write_Int (Int (Standard_Short_Short_Unsigned));
Tree_Write_Int (Int (Standard_Short_Unsigned));
Tree_Write_Int (Int (Standard_Unsigned));
Tree_Write_Int (Int (Standard_Long_Unsigned));
Tree_Write_Int (Int (Standard_Long_Long_Unsigned));
Tree_Write_Int (Int (Standard_Unsigned_64));
Tree_Write_Int (Int (Abort_Signal));
Tree_Write_Int (Int (Standard_Op_Rotate_Left));
Tree_Write_Int (Int (Standard_Op_Rotate_Right));
......
gcc/ada/stand.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
......@@ -37,6 +37,11 @@ with Types; use Types;
package Stand is
-- Warning: the entities defined in this package are written out by the
-- Tree_Write routine, and read back in by the Tree_Read routine, so be
-- sure to modify these two routines if you add entities that are not
-- part of Standard_Entity.
type Standard_Entity_Type is (
-- This enumeration type contains an entry for each name in Standard
......
gcc/ada/tbuild.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
......@@ -205,8 +205,6 @@ package Tbuild is
-- captures the value of an expression (e.g. an aggregate). It should be
-- set whenever possible to point to the expression that is being captured.
-- This is provided to get better error messages, e.g. from CodePeer.
--
-- Make_Temp_Id would probably be a better name for this function???
function Make_Unsuppress_Block
(Loc : Source_Ptr;
......
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