aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/ada/ChangeLog25
-rw-r--r--gcc/ada/exp_attr.adb10
-rw-r--r--gcc/ada/g-sercom-mingw.adb7
-rw-r--r--gcc/ada/g-sercom.ads4
-rw-r--r--gcc/ada/s-oscons-tmplt.c15
-rw-r--r--gcc/ada/sem_ch3.adb5
-rw-r--r--gcc/ada/sinfo.adb16
-rw-r--r--gcc/ada/sinfo.ads22
-rw-r--r--gcc/ada/tree_io.ads4
-rw-r--r--gcc/ada/xoscons.adb39
10 files changed, 87 insertions, 60 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index bb501ff..c48bf74 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,28 @@
+2012-08-06 Robert Dewar <dewar@adacore.com>
+
+ * xoscons.adb: Minor code reorganization (remove unused variable
+ E at line 331).
+ * g-sercom.ads, exp_attr.adb: Minor reformatting.
+ * sinfo.adb, sinfo.ads: Minor cleanup, remove unused flag
+ Static_Processing_OK.
+
+2012-08-06 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch3.adb (Build_Derived_Concurrent_Type): Copy discriminant
+ constraint when building a constrained subtype, to prevent
+ undesirable tree sharing betweeb geberated subtype and derived
+ type definition.
+
+2012-08-06 Thomas Quinot <quinot@adacore.com>
+
+ * g-sercom-mingw.adb, s-oscons-tmplt.c: Add missing constants
+ on Windows.
+
+2012-08-06 Sergey Rybin <rybin@adacore.com frybin>
+
+ * tree_io.ads: Update ASIS_Version_Number because of the tree fix
+ for discriminant constraints for concurrent types.
+
2012-08-06 Thomas Quinot <quinot@adacore.com>
* sem_ch4.adb: Minor reformatting.
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index b0f409d..105df46 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -835,6 +835,11 @@ package body Exp_Attr is
-- Remaining processing depends on specific attribute
+ -- Note: individual sections of the following case statement are
+ -- allowed to assume there is no code after the case statement, and
+ -- are legitimately allowed to execute return statements if they have
+ -- nothing more to do.
+
case Id is
-- Attributes related to Ada 2012 iterators (placeholder ???)
@@ -6074,6 +6079,11 @@ package body Exp_Attr is
null;
end case;
+ -- Note: as mentioned earlier, individual sections of the above case
+ -- statement assume there is no code after the case statement, and are
+ -- legitimately allowed to execute return statements if they have nothing
+ -- more to do, so DO NOT add code at this point.
+
exception
when RE_Not_Available =>
return;
diff --git a/gcc/ada/g-sercom-mingw.adb b/gcc/ada/g-sercom-mingw.adb
index 726d21f..afc4d47 100644
--- a/gcc/ada/g-sercom-mingw.adb
+++ b/gcc/ada/g-sercom-mingw.adb
@@ -37,11 +37,14 @@ with Ada.Streams; use Ada.Streams;
with System; use System;
with System.Communication; use System.Communication;
with System.CRTL; use System.CRTL;
+with System.OS_Constants;
with System.Win32; use System.Win32;
with System.Win32.Ext; use System.Win32.Ext;
package body GNAT.Serial_Communications is
+ package OSC renames System.OS_Constants;
+
-- Common types
type Port_Data is new HANDLE;
@@ -203,9 +206,9 @@ package body GNAT.Serial_Communications is
Com_Settings.fBinary := Bits1 (System.Win32.TRUE);
Com_Settings.fOutxDsrFlow := 0;
Com_Settings.fDsrSensitivity := 0;
- Com_Settings.fDtrControl := DTR_CONTROL_ENABLE;
+ Com_Settings.fDtrControl := OSC.DTR_CONTROL_ENABLE;
Com_Settings.fInX := 0;
- Com_Settings.fRtsControl := RTS_CONTROL_ENABLE;
+ Com_Settings.fRtsControl := OSC.RTS_CONTROL_ENABLE;
case Flow is
when None =>
diff --git a/gcc/ada/g-sercom.ads b/gcc/ada/g-sercom.ads
index b2a6391..573eba2 100644
--- a/gcc/ada/g-sercom.ads
+++ b/gcc/ada/g-sercom.ads
@@ -87,8 +87,8 @@ package GNAT.Serial_Communications is
-- will wait for the whole buffer to be filed. If Block is not set then
-- the given Timeout (in seconds) is used. If Local is set then modem
-- control lines (in particular DCD) are ignored (not supported on
- -- Windows).
-
+ -- Windows). Flow indicates the flow control type as defined above.
+ --
-- Note that the timeout precision may be limited on some implementation
-- (e.g. on GNU/Linux the maximum precision is a tenth of seconds).
diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c
index 062f514..bfd46dd 100644
--- a/gcc/ada/s-oscons-tmplt.c
+++ b/gcc/ada/s-oscons-tmplt.c
@@ -156,6 +156,10 @@ pragma Style_Checks ("M32766");
# include <signal.h>
#endif
+#ifdef __MINGW32__
+# include <winbase.h>
+#endif
+
#ifdef NATIVE
#include <stdio.h>
@@ -621,11 +625,9 @@ CND(E2BIG, "Argument list too long")
CND(EILSEQ, "Illegal byte sequence")
/**
- ** Terminal I/O constants
+ ** Terminal/serial I/O constants
**/
-#ifdef HAVE_TERMIOS
-
/*
----------------------
@@ -634,6 +636,8 @@ CND(EILSEQ, "Illegal byte sequence")
*/
+#ifdef HAVE_TERMIOS
+
#ifndef TCSANOW
# define TCSANOW -1
#endif
@@ -949,6 +953,11 @@ CND(VEOL2, "Alternative EOL")
#endif /* HAVE_TERMIOS */
+#ifdef __MINGW32__
+CNU(DTR_CONTROL_ENABLE, "Enable DTR flow ctrl")
+CNU(RTS_CONTROL_ENABLE, "Enable RTS flow ctrl")
+#endif
+
/*
-----------------------------
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 7080d37..9a690fd 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5432,7 +5432,8 @@ package body Sem_Ch3 is
elsif Constraint_Present then
- -- Build constrained subtype and derive from it
+ -- Build constrained subtype, copying the constraint, and derive
+ -- from it to create a derived constrained type.
declare
Loc : constant Source_Ptr := Sloc (N);
@@ -5446,7 +5447,7 @@ package body Sem_Ch3 is
Make_Subtype_Declaration (Loc,
Defining_Identifier => Anon,
Subtype_Indication =>
- Subtype_Indication (Type_Definition (N)));
+ New_Copy_Tree (Subtype_Indication (Type_Definition (N))));
Insert_Before (N, Decl);
Analyze (Decl);
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index d1c1480..d2413ad 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -2844,14 +2844,6 @@ package body Sinfo is
return List3 (N);
end Statements;
- function Static_Processing_OK
- (N : Node_Id) return Boolean is
- begin
- pragma Assert (False
- or else NT (N).Nkind = N_Aggregate);
- return Flag4 (N);
- end Static_Processing_OK;
-
function Storage_Pool
(N : Node_Id) return Node_Id is
begin
@@ -5905,14 +5897,6 @@ package body Sinfo is
Set_List3_With_Parent (N, Val);
end Set_Statements;
- procedure Set_Static_Processing_OK
- (N : Node_Id; Val : Boolean) is
- begin
- pragma Assert (False
- or else NT (N).Nkind = N_Aggregate);
- Set_Flag4 (N, Val);
- end Set_Static_Processing_OK;
-
procedure Set_Storage_Pool
(N : Node_Id; Val : Node_Id) is
begin
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 50135af..8492948 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -670,7 +670,7 @@ package Sinfo is
-- evaluated at compile time without raising constraint error. Such
-- aggregates can be passed as is to Gigi without any expansion. See
-- Sem_Aggr for the specific conditions under which an aggregate has this
- -- flag set. See also the flag Static_Processing_OK.
+ -- flag set.
-- Componentwise_Assignment (Flag14-Sem)
-- Present in N_Assignment_Statement nodes. Set for a record assignment
@@ -1725,17 +1725,6 @@ package Sinfo is
-- This flag is set in both the N_Aspect_Specification node itself,
-- and in the pragma which is generated from this node.
- -- Static_Processing_OK (Flag4-Sem)
- -- Present in N_Aggregate nodes. When the Compile_Time_Known_Aggregate
- -- flag is set, the full value of the aggregate can be determined at
- -- compile time and the aggregate can be passed as is to the back-end.
- -- In this event it is irrelevant whether this flag is set or not.
- -- However, if the flag Compile_Time_Known_Aggregate is not set but
- -- Static_Processing_OK is set, the aggregate can (but need not) be
- -- converted into a compile time known aggregate by the expander. See
- -- Sem_Aggr for the specific conditions under which an aggregate has its
- -- Static_Processing_OK flag set.
-
-- Storage_Pool (Node1-Sem)
-- Present in N_Allocator, N_Free_Statement, N_Simple_Return_Statement,
-- and N_Extended_Return_Statement nodes. References the entity for the
@@ -3391,7 +3380,6 @@ package Sinfo is
-- Null_Record_Present (Flag17)
-- Aggregate_Bounds (Node3-Sem)
-- Associated_Node (Node4-Sem)
- -- Static_Processing_OK (Flag4-Sem)
-- Compile_Time_Known_Aggregate (Flag18-Sem)
-- Expansion_Delayed (Flag11-Sem)
-- Has_Self_Reference (Flag13-Sem)
@@ -8969,9 +8957,6 @@ package Sinfo is
function Statements
(N : Node_Id) return List_Id; -- List3
- function Static_Processing_OK
- (N : Node_Id) return Boolean; -- Flag4
-
function Storage_Pool
(N : Node_Id) return Node_Id; -- Node1
@@ -9944,9 +9929,6 @@ package Sinfo is
procedure Set_Statements
(N : Node_Id; Val : List_Id); -- List3
- procedure Set_Static_Processing_OK
- (N : Node_Id; Val : Boolean); -- Flag4
-
procedure Set_Storage_Pool
(N : Node_Id; Val : Node_Id); -- Node1
@@ -12074,7 +12056,6 @@ package Sinfo is
pragma Inline (Specification);
pragma Inline (Split_PPC);
pragma Inline (Statements);
- pragma Inline (Static_Processing_OK);
pragma Inline (Storage_Pool);
pragma Inline (Subpool_Handle_Name);
pragma Inline (Strval);
@@ -12394,7 +12375,6 @@ package Sinfo is
pragma Inline (Set_Specification);
pragma Inline (Set_Split_PPC);
pragma Inline (Set_Statements);
- pragma Inline (Set_Static_Processing_OK);
pragma Inline (Set_Storage_Pool);
pragma Inline (Set_Subpool_Handle_Name);
pragma Inline (Set_Strval);
diff --git a/gcc/ada/tree_io.ads b/gcc/ada/tree_io.ads
index 12c1ae5..9fa2121 100644
--- a/gcc/ada/tree_io.ads
+++ b/gcc/ada/tree_io.ads
@@ -47,7 +47,7 @@ package Tree_IO is
Tree_Format_Error : exception;
-- Raised if a format error is detected in the input file
- ASIS_Version_Number : constant := 28;
+ ASIS_Version_Number : constant := 29;
-- ASIS Version. This is used to check for consistency between the compiler
-- used to generate trees and an ASIS application that is reading the
-- trees. It must be incremented whenever a change is made to the tree
@@ -56,6 +56,8 @@ package Tree_IO is
--
-- 27 Changes in the tree structures for expression functions
-- 28 Changes in Snames
+ -- 29 Changes in Sem_Ch3 (tree copying in case of discriminant constraint
+ -- for concurrent types).
procedure Tree_Read_Initialize (Desc : File_Descriptor);
-- Called to initialize reading of a tree file. This call must be made
diff --git a/gcc/ada/xoscons.adb b/gcc/ada/xoscons.adb
index 73e3322..c740aa2 100644
--- a/gcc/ada/xoscons.adb
+++ b/gcc/ada/xoscons.adb
@@ -45,7 +45,7 @@ pragma Warnings (On);
with GNAT.Table;
-with XUtil; use XUtil;
+with XUtil; use XUtil;
procedure XOSCons is
@@ -178,10 +178,12 @@ procedure XOSCons is
Put (OFile, S);
end Put;
+ -- Start of processing for Output_Info
+
begin
- if Info.Kind /= TXT then
- -- TXT case is handled by the common code below
+ -- Case of non-TXT case (TXT case handled by common code below)
+ if Info.Kind /= TXT then
case Lang is
when Lang_Ada =>
Put (" " & Info.Constant_Name.all);
@@ -207,6 +209,7 @@ procedure XOSCons is
if not Info.Int_Value.Positive then
Put ("-");
end if;
+
Put (Trim (Info.Int_Value.Abs_Value'Img, Side => Left));
else
@@ -214,11 +217,14 @@ procedure XOSCons is
Is_String : constant Boolean :=
Info.Kind = C
and then Info.Constant_Type.all = "String";
+
begin
if Is_String then
Put ("""");
end if;
+
Put (Info.Text_Value.all);
+
if Is_String then
Put ("""");
end if;
@@ -290,6 +296,7 @@ procedure XOSCons is
is
First : Integer := S'First;
Result : Int_Value_Type;
+
begin
-- On some platforms, immediate integer values are prefixed with
-- a $ or # character in assembly output.
@@ -300,7 +307,7 @@ procedure XOSCons is
if S (First) = '-' then
Result.Positive := False;
- First := First + 1;
+ First := First + 1;
else
Result.Positive := True;
end if;
@@ -308,6 +315,7 @@ procedure XOSCons is
Result.Abs_Value := Long_Unsigned'Value (S (First .. S'Last));
if not Result.Positive and then K = CNU then
+
-- Negative value, but unsigned expected: take 2's complement
-- reciprocical value.
@@ -320,7 +328,7 @@ procedure XOSCons is
return Result;
exception
- when E : others =>
+ when others =>
Put_Line (Standard_Error, "can't parse decimal value: " & S);
raise;
end Parse_Int;
@@ -346,6 +354,7 @@ procedure XOSCons is
Find_Colon (Index2);
Info.Constant_Name := Field_Alloc;
+
if Info.Constant_Name'Length > Max_Constant_Name_Len then
Max_Constant_Name_Len := Info.Constant_Name'Length;
end if;
@@ -355,6 +364,7 @@ procedure XOSCons is
if Info.Kind = C then
Info.Constant_Type := Field_Alloc;
+
if Info.Constant_Type'Length > Max_Constant_Type_Len then
Max_Constant_Type_Len := Info.Constant_Type'Length;
end if;
@@ -367,6 +377,7 @@ procedure XOSCons is
Info.Int_Value :=
Parse_Int (Line (Index1 .. Index2 - 1), Info.Kind);
Info.Value_Len := Info.Int_Value.Abs_Value'Img'Length - 1;
+
if not Info.Int_Value.Positive then
Info.Value_Len := Info.Value_Len + 1;
end if;
@@ -403,12 +414,13 @@ procedure XOSCons is
Asm_Infos.Append (Info);
end;
+
exception
when E : others =>
- Put_Line (Standard_Error,
- "can't parse " & Line);
- Put_Line (Standard_Error,
- "exception raised: " & Exception_Information (E));
+ Put_Line
+ (Standard_Error, "can't parse " & Line);
+ Put_Line
+ (Standard_Error, "exception raised: " & Exception_Information (E));
end Parse_Asm_Line;
------------
@@ -433,8 +445,8 @@ procedure XOSCons is
-- Output files
- Ada_File_Name : constant String := Unit_Name & ".ads";
- C_File_Name : constant String := Unit_Name & ".h";
+ Ada_File_Name : constant String := Unit_Name & ".ads";
+ C_File_Name : constant String := Unit_Name & ".h";
Asm_File : Ada.Text_IO.File_Type;
Tmpl_File : Ada.Text_IO.File_Type;
@@ -456,7 +468,6 @@ begin
-- Load values from assembly file
Open (Asm_File, In_File, Asm_File_Name);
-
while not End_Of_File (Asm_File) loop
Get_Line (Asm_File, Line, Last);
if Last > 2 and then Line (1 .. 2) = "->" then
@@ -482,8 +493,10 @@ begin
if Last >= 2 and then Line (1 .. 2) = "# " then
declare
- Index : Integer := 3;
+ Index : Integer;
+
begin
+ Index := 3;
while Index <= Last and then Line (Index) in '0' .. '9' loop
Index := Index + 1;
end loop;
generated by cgit v1.1 at 2024-10-25 23:30:00 +0000