From 088617480edbbec355bad2aed392f94aa6333f83 Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 6 Aug 2012 08:41:41 +0000 Subject: [PATCH] 2012-08-06 Robert Dewar * 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 * 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 * g-sercom-mingw.adb, s-oscons-tmplt.c: Add missing constants on Windows. 2012-08-06 Sergey Rybin * tree_io.ads: Update ASIS_Version_Number because of the tree fix for discriminant constraints for concurrent types. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@190171 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 25 +++++++++++++++++++++++++ gcc/ada/exp_attr.adb | 10 ++++++++++ gcc/ada/g-sercom-mingw.adb | 7 +++++-- gcc/ada/g-sercom.ads | 4 ++-- gcc/ada/s-oscons-tmplt.c | 15 ++++++++++++--- gcc/ada/sem_ch3.adb | 5 +++-- gcc/ada/sinfo.adb | 16 ---------------- gcc/ada/sinfo.ads | 22 +--------------------- gcc/ada/tree_io.ads | 4 +++- gcc/ada/xoscons.adb | 39 ++++++++++++++++++++++++++------------- 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 + + * 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 + + * 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 + + * g-sercom-mingw.adb, s-oscons-tmplt.c: Add missing constants + on Windows. + +2012-08-06 Sergey Rybin + + * tree_io.ads: Update ASIS_Version_Number because of the tree fix + for discriminant constraints for concurrent types. + 2012-08-06 Thomas Quinot * 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 #endif +#ifdef __MINGW32__ +# include +#endif + #ifdef NATIVE #include @@ -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; -- 2.7.4