From: Arnaud Charlet Date: Mon, 20 Apr 2009 12:17:42 +0000 (+0200) Subject: [multiple changes] X-Git-Tag: releases/gcc-4.5.0~6365 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=8737a29a325411b422a550958bd4a01613c5a48f;p=thirdparty%2Fgcc.git [multiple changes] 2009-04-20 Robert Dewar * sinfo.ads: Minor comment fixes * exp_disp.adb: Minor reformatting * gnat1drv.adb: Minor reformatting * output.adb: Minor reformatting * s-vxwext-kernel.ads: Minor reformatting * sem.ads: Minor reformatting * sem.adb: Minor reformatting * sem_elim.adb: Minor reformatting * uname.ads: Minor reformatting 2009-04-20 Eric Botcazou * init.c (__gnat_adjust_context_for_raise): On x86{-64}/Linux, add a small dope of 4 words to the adjustment to the stack pointer. 2009-04-20 Thomas Quinot * xoscons.adb: generate C header s-oscons.h in addition to s-oscons.ads. * socket.c: On VMS, use s-oscons.h. * sem_ch3.adb: Minor reformatting * exp_ch9.adb: Minor reformatting From-SVN: r146401 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d94ea39bc94b..0cb78558f2bb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,39 @@ +2009-04-20 Robert Dewar + + * sinfo.ads: Minor comment fixes + + * exp_disp.adb: Minor reformatting + + * gnat1drv.adb: Minor reformatting + + * output.adb: Minor reformatting + + * s-vxwext-kernel.ads: Minor reformatting + + * sem.ads: Minor reformatting + + * sem.adb: Minor reformatting + + * sem_elim.adb: Minor reformatting + + * uname.ads: Minor reformatting + +2009-04-20 Eric Botcazou + + * init.c (__gnat_adjust_context_for_raise): On x86{-64}/Linux, add + a small dope of 4 words to the adjustment to the stack pointer. + +2009-04-20 Thomas Quinot + + * xoscons.adb: generate C header s-oscons.h in + addition to s-oscons.ads. + + * socket.c: On VMS, use s-oscons.h. + + * sem_ch3.adb: Minor reformatting + + * exp_ch9.adb: Minor reformatting + 2009-04-20 Eric Botcazou * gcc-interface/trans.c (check_for_eliminated_entity): Remove. diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index e142d2debbe1..f784e54ef3ac 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -7217,7 +7217,7 @@ package body Exp_Ch9 is when N_Subprogram_Body => - -- Do not create bodies for eliminated operations. + -- Do not create bodies for eliminated operations if not Is_Eliminated (Defining_Entity (Op_Body)) and then not Is_Eliminated (Corresponding_Spec (Op_Body)) @@ -7225,13 +7225,13 @@ package body Exp_Ch9 is New_Op_Body := Build_Unprotected_Subprogram_Body (Op_Body, Pid); - -- Propagate the finalization chain to the new body. - -- In the unlikely event that the subprogram contains a - -- declaration or allocator for an object that requires - -- finalization, the corresponding chain is created when - -- analyzing the body, and attached to its entity. This - -- entity is not further elaborated, and so the chain - -- properly belongs to the newly created subprogram body. + -- Propagate the finalization chain to the new body. In the + -- unlikely event that the subprogram contains a declaration + -- or allocator for an object that requires finalization, + -- the corresponding chain is created when analyzing the + -- body, and attached to its entity. This entity is not + -- further elaborated, and so the chain properly belongs to + -- the newly created subprogram body. Chain := Finalization_Chain_Entity (Defining_Entity (Op_Body)); @@ -7252,11 +7252,11 @@ package body Exp_Ch9 is -- appear that this is needed only if this is a visible -- operation of the type, or if it is an interrupt handler, -- and this was the strategy used previously in GNAT. - -- However, the operation may be exported through a - -- 'Access to an external caller. This is the common idiom - -- in code that uses the Ada 2005 Timing_Events package - -- As a result we need to produce the protected body for - -- both visible and private operations. + -- However, the operation may be exported through a 'Access + -- to an external caller. This is the common idiom in code + -- that uses the Ada 2005 Timing_Events package. As a result + -- we need to produce the protected body for both visible + -- and private operations. if Present (Corresponding_Spec (Op_Body)) then Op_Decl := diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 85a51f3e633b..7df455015361 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -179,12 +179,12 @@ package body Exp_Disp is or else (not Comes_From_Source (Defining_Entity (D)) and then - Has_Unknown_Discriminants (Etype (Defining_Entity (D))) + Has_Unknown_Discriminants (Etype (Defining_Entity (D))) and then - not Comes_From_Source (First_Subtype (Defining_Entity (D)))) + not Comes_From_Source + (First_Subtype (Defining_Entity (D)))) then null; - else Insert_List_After_And_Analyze (Last (Target_List), Make_DT (Defining_Entity (D))); diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index 2fa24f4741a6..9d2a4957e03f 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -258,13 +258,18 @@ procedure Gnat1drv is -- Check_Library_Items -- ------------------------- + -- Walk_Library_Items has plenty of assertions, so all we need to do is + -- call it, just for these assertions, not actually doing anything else. + procedure Check_Library_Items is - -- Walk_Library_Items has plenty of assertions, so all we need to do is - -- call it. procedure Action (Item : Node_Id); -- Action passed to Walk_Library_Items to do nothing + ------------ + -- Action -- + ------------ + procedure Action (Item : Node_Id) is begin null; @@ -272,7 +277,8 @@ procedure Gnat1drv is procedure Walk is new Sem.Walk_Library_Items (Action); - -- Start of processing for Check_Library_Items + -- Start of processing for Check_Library_Items + begin Walk; end Check_Library_Items; diff --git a/gcc/ada/init.c b/gcc/ada/init.c index 59aabf2466c7..16a9662b8e18 100644 --- a/gcc/ada/init.c +++ b/gcc/ada/init.c @@ -592,20 +592,21 @@ __gnat_adjust_context_for_raise (int signo ATTRIBUTE_UNUSED, void *ucontext) by the time the EH return is executed. We therefore adjust the saved value of the stack pointer by the size - of one page, in order to make sure that it points to an accessible - address in case it's used as the target CFA. The stack checking code - guarantees that this page is unused by the time this happens. */ + of one page + a small dope of 4 words, in order to make sure that it + points to an accessible address in case it's used as the target CFA. + The stack checking code guarantees that this address is unused by the + time this happens. */ #if defined (i386) unsigned long pattern = *(unsigned long *)mcontext->gregs[REG_EIP]; /* The pattern is "orl $0x0,(%esp)" for a probe in 32-bit mode. */ if (signo == SIGSEGV && pattern == 0x00240c83) - mcontext->gregs[REG_ESP] += 4096; + mcontext->gregs[REG_ESP] += 4096 + 4 * sizeof (unsigned long); #elif defined (__x86_64__) unsigned long pattern = *(unsigned long *)mcontext->gregs[REG_RIP]; /* The pattern is "orq $0x0,(%rsp)" for a probe in 64-bit mode. */ if (signo == SIGSEGV && (pattern & 0xffffffffff) == 0x00240c8348) - mcontext->gregs[REG_RSP] += 4096; + mcontext->gregs[REG_RSP] += 4096 + 4 * sizeof (unsigned long); #elif defined (__ia64__) /* ??? The IA-64 unwinder doesn't compensate for signals. */ mcontext->sc_ip++; diff --git a/gcc/ada/output.adb b/gcc/ada/output.adb index 851f11850b8d..745d47fab388 100644 --- a/gcc/ada/output.adb +++ b/gcc/ada/output.adb @@ -162,9 +162,11 @@ package body Output is procedure Indent is begin + -- The "mod" in the following assignment is to cause a wrap around in + -- the case where there is too much indentation. + Cur_Indentation := (Cur_Indentation + Indentation_Amount) mod Indentation_Limit; - -- The "mod" is to wrap around in case there's too much indentation end Indent; ------------- @@ -173,6 +175,8 @@ package body Output is procedure Outdent is begin + -- The "mod" here undoes the wrap around from Indent above + Cur_Indentation := (Cur_Indentation - Indentation_Amount) mod Indentation_Limit; end Outdent; diff --git a/gcc/ada/s-vxwext-kernel.ads b/gcc/ada/s-vxwext-kernel.ads index 4e9cb818428f..c1883abdff6a 100644 --- a/gcc/ada/s-vxwext-kernel.ads +++ b/gcc/ada/s-vxwext-kernel.ads @@ -78,7 +78,7 @@ package System.VxWorks.Ext is type UINT64 is mod 2 ** Long_Long_Integer'Size; function tickGet return UINT64; - -- needed for ravenscar-cert + -- Needed for ravenscar-cert pragma Import (C, tickGet, "tick64Get"); end System.VxWorks.Ext; diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb index c6c2c0011b5a..5e2fa1bdbd0f 100644 --- a/gcc/ada/sem.adb +++ b/gcc/ada/sem.adb @@ -1477,14 +1477,14 @@ package body Sem is -- assertions and debugging output. case Nkind (Item) is - when N_Generic_Subprogram_Declaration | - N_Generic_Package_Declaration | - N_Package_Declaration | - N_Subprogram_Declaration | - N_Subprogram_Renaming_Declaration | - N_Package_Renaming_Declaration | + when N_Generic_Subprogram_Declaration | + N_Generic_Package_Declaration | + N_Package_Declaration | + N_Subprogram_Declaration | + N_Subprogram_Renaming_Declaration | + N_Package_Renaming_Declaration | N_Generic_Function_Renaming_Declaration | - N_Generic_Package_Renaming_Declaration | + N_Generic_Package_Renaming_Declaration | N_Generic_Procedure_Renaming_Declaration => null; -- Specs are OK @@ -1497,8 +1497,8 @@ package body Sem is -- All other cases cannot happen when N_Function_Instantiation | - N_Procedure_Instantiation | - N_Package_Instantiation => + N_Procedure_Instantiation | + N_Package_Instantiation => pragma Assert (False, "instantiation"); null; @@ -1520,15 +1520,20 @@ package body Sem is Write_Int (Int (Get_Cunit_Unit_Number (CU))); Write_Str (", "); Write_Str (Node_Kind'Image (Nkind (Item))); + if Item /= Original_Node (Item) then Write_Str (", orig = "); Write_Str (Node_Kind'Image (Nkind (Original_Node (Item)))); end if; + Write_Eol; end if; - else -- Must be Standard + else + -- Must be Standard + pragma Assert (Item = Stand.Standard_Package_Node); + if Enable_Output then Write_Line ("Standard"); end if; @@ -1537,9 +1542,11 @@ package body Sem is Action (Item); end Do_Action; + -- Local Declarations + Cur : Elmt_Id := First_Elmt (Comp_Unit_List); - -- Start of processing for Walk_Library_Items + -- Start of processing for Walk_Library_Items begin if Enable_Output then @@ -1555,10 +1562,12 @@ package body Sem is declare CU : constant Node_Id := Node (Cur); N : constant Node_Id := Unit (CU); + begin pragma Assert (Nkind (CU) = N_Compilation_Unit); case Nkind (N) is + -- If it's a body, then ignore it, unless it's an instance (in -- which case we do the spec), or it's the main unit (in which -- case we do it). Note that it could be both. @@ -1566,13 +1575,18 @@ package body Sem is when N_Package_Body | N_Subprogram_Body => declare Entity : Node_Id := N; + begin if Nkind (N) = N_Subprogram_Body then Entity := Specification (Entity); end if; + Entity := Defining_Unit_Name (Entity); + if Nkind (Entity) not in N_Entity then + -- Must be N_Defining_Program_Unit_Name + Entity := Defining_Identifier (Entity); end if; @@ -1582,6 +1596,7 @@ package body Sem is end; if CU = Cunit (Main_Unit) then + -- Must come last pragma Assert (No (Next_Elmt (Cur))); diff --git a/gcc/ada/sem.ads b/gcc/ada/sem.ads index 544178bc921b..a1873e86defa 100644 --- a/gcc/ada/sem.ads +++ b/gcc/ada/sem.ads @@ -651,7 +651,7 @@ package Sem is -- is the N_Package_Declaration node for package Standard. Bodies are not -- included, except for the main unit itself, which always comes last. -- - -- Item is never a subunit. + -- Item is never a subunit -- -- Item is never an instantiation. Instead, the instance declaration is -- passed, and (if the instantiation is the main unit), the instance body. diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index b72fb2f06692..3fc35a2fadb2 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4037,29 +4037,25 @@ package body Sem_Ch3 is -- This does not apply if the base type is a generic type, whose -- declaration is independent of the current derived definition. - if B /= T - and then not Is_Generic_Type (B) - then + if B /= T and then not Is_Generic_Type (B) then Ensure_Freeze_Node (B); Set_First_Subtype_Link (Freeze_Node (B), T); end if; -- A type that is imported through a limited_with clause cannot - -- generate any code, and thus need not be frozen. However, an - -- access type with an imported designated type needs a finalization - -- list, which may be referenced in some other package that has - -- non-limited visibility on the designated type. Thus we must - -- create the finalization list at the point the access type is - -- frozen, to prevent unsatisfied references at link time. - - if not From_With_Type (T) - or else Is_Access_Type (T) - then + -- generate any code, and thus need not be frozen. However, an access + -- type with an imported designated type needs a finalization list, + -- which may be referenced in some other package that has non-limited + -- visibility on the designated type. Thus we must create the + -- finalization list at the point the access type is frozen, to + -- prevent unsatisfied references at link time. + + if not From_With_Type (T) or else Is_Access_Type (T) then Set_Has_Delayed_Freeze (T); end if; end; - -- Case of T is the full declaration of some private type which has + -- Case where T is the full declaration of some private type which has -- been swapped in Defining_Identifier (N). if T /= Def_Id and then Is_Private_Type (Def_Id) then @@ -4101,7 +4097,7 @@ package body Sem_Ch3 is Generate_Definition (Def_Id); end if; - if Chars (Scope (Def_Id)) = Name_System + if Chars (Scope (Def_Id)) = Name_System and then Chars (Def_Id) = Name_Address and then Is_Predefined_File_Name (Unit_File_Name (Get_Source_Unit (N))) then diff --git a/gcc/ada/sem_elim.adb b/gcc/ada/sem_elim.adb index ddcb32b8fc59..d285e08355c5 100644 --- a/gcc/ada/sem_elim.adb +++ b/gcc/ada/sem_elim.adb @@ -674,7 +674,6 @@ package body Sem_Elim is begin if Is_Eliminated (Ultimate_Subp) and then not Inside_A_Generic then - Enclosing_Subp := Current_Subprogram; while Present (Enclosing_Subp) loop if Is_Eliminated (Enclosing_Subp) then diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 730419ae7816..7343a95f9829 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -5319,7 +5319,7 @@ package Sinfo is -- There is no explicit node in the tree for a compilation, since in -- general the compiler is processing only a single compilation unit -- at a time. It is possible to parse multiple units in syntax check - -- only mode, but they the trees are discarded in any case. + -- only mode, but the trees are discarded in that case. ------------------------------ -- 10.1.1 Compilation Unit -- @@ -5389,7 +5389,7 @@ package Sinfo is -- There is no explicit node in the tree for library item, instead -- the declaration or body, and the flag for private if present, - -- appear in the N_Compilation_Unit clause. + -- appear in the N_Compilation_Unit node. -------------------------------------- -- 10.1.1 Library Unit Declaration -- diff --git a/gcc/ada/socket.c b/gcc/ada/socket.c index 4ac17e2fbbf1..226f3be85928 100644 --- a/gcc/ada/socket.c +++ b/gcc/ada/socket.c @@ -32,6 +32,15 @@ /* This file provides a portable binding to the sockets API */ #include "gsocket.h" +#ifdef VMS +/* + * For VMS, gsocket.h can't include sockets-related DEC C header files + * when building the runtime (because these files are in DEC C archives, + * not accessable to GCC). So, we generate a separate header file along + * with s-oscons.ads and include it here. + */ +# include "s-oscons.h" +#endif #if defined(HAVE_SOCKETS) diff --git a/gcc/ada/uname.ads b/gcc/ada/uname.ads index d52204080853..c1b59b6cb929 100644 --- a/gcc/ada/uname.ads +++ b/gcc/ada/uname.ads @@ -38,11 +38,11 @@ package Uname is -- Unit Name Conventions -- --------------------------- - -- Units are associated with a unique ASCII name as follows. First we - -- have the fully expanded name of the unit, with lower case letters - -- (except for the use of upper case letters for encoding upper half - -- and wide characters, as described in Namet), and periods. Following - -- this is one of the following suffixes: + -- Units are associated with a unique ASCII name as follows. First we have + -- the fully expanded name of the unit, with lower case letters (except + -- for the use of upper case letters for encoding upper half and wide + -- characters, as described in Namet), and periods. Following this is one + -- of the following suffixes: -- %s for package/subprogram/generic declarations (specs) -- %b for package/subprogram/generic bodies and subunits @@ -144,11 +144,11 @@ package Uname is function New_Child (Old : Unit_Name_Type; Newp : Unit_Name_Type) return Unit_Name_Type; - -- Old is a child unit name (for either a body or spec). Newp is the - -- unit name of the actual parent (this may be different from the - -- parent in old). The returned unit name is formed by taking the - -- parent name from Newp and the child unit name from Old, with the - -- result being a body or spec depending on Old. For example: + -- Old is a child unit name (for either a body or spec). Newp is the unit + -- name of the actual parent (this may be different from the parent in + -- old). The returned unit name is formed by taking the parent name from + -- Newp and the child unit name from Old, with the result being a body or + -- spec depending on Old. For example: -- -- Old = A.B.C (body) -- Newp = A.R (spec) diff --git a/gcc/ada/xoscons.adb b/gcc/ada/xoscons.adb index 4f5e4a291c71..64a9e799a3f9 100644 --- a/gcc/ada/xoscons.adb +++ b/gcc/ada/xoscons.adb @@ -105,11 +105,16 @@ procedure XOSCons is Table_Initial => 100, Table_Increment => 10); - Max_Constant_Name_Len : Natural := 0; + Max_Const_Name_Len : Natural := 0; Max_Constant_Value_Len : Natural := 0; -- Longest name and longest value lengths - procedure Output_Info (OFile : Sfile; Info_Index : Integer); + type Language is (Lang_Ada, Lang_C); + + procedure Output_Info + (Lang : Language; + OFile : Sfile; + Info_Index : Integer); -- Output information from the indicated asm info line procedure Parse_Asm_Line (Line : String); @@ -128,14 +133,22 @@ procedure XOSCons is function Contains_Template_Name (S : String) return Boolean is begin - return Index (Source => To_Lower (S), Pattern => Tmpl_Name) > 0; + if Index (Source => To_Lower (S), Pattern => Tmpl_Name) > 0 then + return True; + else + return False; + end if; end Contains_Template_Name; ----------------- -- Output_Info -- ----------------- - procedure Output_Info (OFile : Sfile; Info_Index : Integer) is + procedure Output_Info + (Lang : Language; + OFile : Sfile; + Info_Index : Integer) + is Info : Asm_Info renames Asm_Infos.Table (Info_Index); procedure Put (S : String); @@ -153,11 +166,17 @@ procedure XOSCons is if Info.Kind /= TXT then -- TXT case is handled by the common code below - Put (" "); - Put (Info.Constant_Name.all); - Put (Spaces (Max_Constant_Name_Len - Info.Constant_Name'Length)); + case Lang is + when Lang_Ada => + Put (" " & Info.Constant_Name.all); + Put (Spaces (Max_Const_Name_Len - Info.Constant_Name'Length)); - Put (" : constant := "); + Put (" : constant := "); + + when Lang_C => + Put ("#define " & Info.Constant_Name.all & " "); + Put (Spaces (Max_Const_Name_Len - Info.Constant_Name'Length)); + end case; if Info.Kind = CND then if not Info.Int_Value.Positive then @@ -168,15 +187,20 @@ procedure XOSCons is Put (Info.Text_Value.all); end if; - Put (";"); + if Lang = Lang_Ada then + Put (";"); - if Info.Comment'Length > 0 then - Put (Spaces (Max_Constant_Value_Len - Info.Value_Len)); - Put (" -- "); + if Info.Comment'Length > 0 then + Put (Spaces (Max_Constant_Value_Len - Info.Value_Len)); + Put (" -- "); + end if; end if; end if; - Put (Info.Comment.all); + if Lang = Lang_Ada then + Put (Info.Comment.all); + end if; + New_Line (OFile); end Output_Info; @@ -272,8 +296,8 @@ 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; + if Info.Constant_Name'Length > Max_Const_Name_Len then + Max_Const_Name_Len := Info.Constant_Name'Length; end if; Index1 := Index2 + 1; @@ -332,13 +356,20 @@ procedure XOSCons is -- Local declarations - Asm_File_Name : constant String := Tmpl_Name & ".s"; + -- Input files + Tmpl_File_Name : constant String := Tmpl_Name & ".i"; + Asm_File_Name : constant String := Tmpl_Name & ".s"; + + -- Output files + 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; - OFile : Sfile; + Ada_OFile : Sfile; + C_OFile : Sfile; Line : String (1 .. 256); Last : Integer; @@ -368,7 +399,8 @@ begin -- Load C template and output definitions Open (Tmpl_File, In_File, Tmpl_File_Name); - Create (OFile, Out_File, Ada_File_Name); + Create (Ada_OFile, Out_File, Ada_File_Name); + Create (C_OFile, Out_File, C_File_Name); Current_Line := 0; Current_Info := Asm_Infos.First; @@ -398,16 +430,20 @@ begin elsif In_Template then if In_Comment then if Line (1 .. Last) = "*/" then + Put_Line (C_OFile, Line (1 .. Last)); In_Comment := False; else - Put_Line (OFile, Line (1 .. Last)); + Put_Line (Ada_OFile, Line (1 .. Last)); + Put_Line (C_OFile, Line (1 .. Last)); end if; elsif Line (1 .. Last) = "/*" then + Put_Line (C_OFile, Line (1 .. Last)); In_Comment := True; elsif Asm_Infos.Table (Current_Info).Line_Number = Current_Line then - Output_Info (OFile, Current_Info); + Output_Info (Lang_Ada, Ada_OFile, Current_Info); + Output_Info (Lang_C, C_OFile, Current_Info); Current_Info := Current_Info + 1; end if; Current_Line := Current_Line + 1;