[multiple changes]
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. From-SVN: r190171
This commit is contained in:
Arnaud Charlet
parent
cc6c4d6288
commit
2eef7403a0
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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 =>
|
||||
|
|
|
|||
|
|
@ -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).
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
/*
|
||||
|
||||
-----------------------------
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
begin
|
||||
if Info.Kind /= TXT then
|
||||
-- TXT case is handled by the common code below
|
||||
-- Start of processing for Output_Info
|
||||
|
||||
begin
|
||||
-- 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;
|
||||
|
|
|
|||
Loading…
Reference in New Issue