+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.
-- 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 ???)
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;
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;
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 =>
-- 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).
# include <signal.h>
#endif
+#ifdef __MINGW32__
+# include <winbase.h>
+#endif
+
#ifdef NATIVE
#include <stdio.h>
CND(EILSEQ, "Illegal byte sequence")
/**
- ** Terminal I/O constants
+ ** Terminal/serial I/O constants
**/
-#ifdef HAVE_TERMIOS
-
/*
----------------------
*/
+#ifdef HAVE_TERMIOS
+
#ifndef TCSANOW
# define TCSANOW -1
#endif
#endif /* HAVE_TERMIOS */
+#ifdef __MINGW32__
+CNU(DTR_CONTROL_ENABLE, "Enable DTR flow ctrl")
+CNU(RTS_CONTROL_ENABLE, "Enable RTS flow ctrl")
+#endif
+
/*
-----------------------------
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);
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);
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
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
-- 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
-- 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
-- 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)
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
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
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);
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);
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
--
-- 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
with GNAT.Table;
-with XUtil; use XUtil;
+with XUtil; use XUtil;
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);
if not Info.Int_Value.Positive then
Put ("-");
end if;
+
Put (Trim (Info.Int_Value.Abs_Value'Img, Side => Left));
else
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;
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.
if S (First) = '-' then
Result.Positive := False;
- First := First + 1;
+ First := First + 1;
else
Result.Positive := True;
end if;
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.
return Result;
exception
- when E : others =>
+ when others =>
Put_Line (Standard_Error, "can't parse decimal value: " & S);
raise;
end Parse_Int;
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;
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;
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;
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;
------------
-- 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;
-- 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
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;
projects / thirdparty / gcc.git / commitdiff
