From 63d0d1a376737338f737587dbe0efb98a7a8101d Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 29 Oct 2012 11:21:52 +0100 Subject: [PATCH] [multiple changes] 2012-10-29 Robert Dewar * warnsw.adb: Complete previous change. 2012-10-29 Tristan Gingold * bindgen.adb (Check_File_In_Partition, Check_System_Restrictions_Used): Removed. (Check_Dispatching_Domains_Used): Removed. (Gen_Adafinal): Remove call to above procedures. (Resolve_Binder_Options): Handle system restrictions and dispatching domains. 2012-10-29 Tristan Gingold * s-tarest.ads, s-tarest.adb (Create_Restricted_Task): Remove Chain parameter. * exp_ch9.adb (Make_Task_Create_Call): Do not add Chain parameter on restricted runtime. 2012-10-29 Pascal Obry * g-sechas.adb, g-sechas.ads: Minor code clean-up. From-SVN: r192920 --- gcc/ada/ChangeLog | 24 +++++++++++ gcc/ada/bindgen.adb | 112 +++++++++++++++++++-------------------------------- gcc/ada/exp_ch9.adb | 9 +++-- gcc/ada/g-sechas.adb | 4 +- gcc/ada/g-sechas.ads | 11 +++-- gcc/ada/s-tarest.adb | 3 -- gcc/ada/s-tarest.ads | 9 +---- gcc/ada/warnsw.adb | 1 + 8 files changed, 79 insertions(+), 94 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7ec41ce..f148bc8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2012-10-29 Robert Dewar + + * warnsw.adb: Complete previous change. + +2012-10-29 Tristan Gingold + + * bindgen.adb (Check_File_In_Partition, Check_System_Restrictions_Used): + Removed. + (Check_Dispatching_Domains_Used): Removed. + (Gen_Adafinal): Remove call to above procedures. + (Resolve_Binder_Options): Handle system restrictions and dispatching + domains. + +2012-10-29 Tristan Gingold + + * s-tarest.ads, s-tarest.adb (Create_Restricted_Task): Remove + Chain parameter. + * exp_ch9.adb (Make_Task_Create_Call): Do not add Chain parameter + on restricted runtime. + +2012-10-29 Pascal Obry + + * g-sechas.adb, g-sechas.ads: Minor code clean-up. + 2012-10-29 Ed Schonberg * sem_aux.adb (Get_Rep_Item): Treat Priority and Interrupt_Priority diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index 36c4196..08a3e8e 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -63,20 +63,20 @@ package body Bindgen is Num_Elab_Calls : Nat := 0; -- Number of generated calls to elaboration routines - System_Restrictions_Used : Boolean; + System_Restrictions_Used : Boolean := False; -- Flag indicating whether the unit System.Restrictions is in the closure - -- of the partition. This is set by Check_System_Restrictions_Used, and + -- of the partition. This is set by Resolve_Binder_Options, and -- is used to determine whether or not to initialize the restrictions -- information in the body of the binder generated file (we do not want -- to do this unconditionally, since it drags in the System.Restrictions -- unit unconditionally, which is unpleasand, especially for ZFP etc.) - Dispatching_Domains_Used : Boolean; + Dispatching_Domains_Used : Boolean := False; -- Flag indicating whether multiprocessor dispatching domains are used in - -- the closure of the partition. This is set by - -- Check_Dispatching_Domains_Used, and is used to call the routine to - -- disallow the creation of new dispatching domains just before calling - -- the main procedure from the environment task. + -- the closure of the partition. This is set by Resolve_Binder_Options, + -- and is used to call the routine to disallow the creation of new + -- dispatching domains just before calling the main procedure from the + -- environment task. System_Tasking_Restricted_Stages_Used : Boolean := False; -- Flag indicating whether the unit System.Tasking.Restricted.Stages is in @@ -242,21 +242,6 @@ package body Bindgen is -- Local Subprograms -- ----------------------- - procedure Check_File_In_Partition - (File_Name : String; - Flag : out Boolean); - -- If the file indicated by File_Name is in the partition the Flag is set - -- to True, False otherwise. - - procedure Check_System_Restrictions_Used; - -- Sets flag System_Restrictions_Used (Set to True if and only if the unit - -- System.Restrictions is present in the partition, otherwise False). - - procedure Check_Dispatching_Domains_Used; - -- Sets flag Dispatching_Domains_Used to True when using the unit - -- System.Multiprocessors.Dispatching_Domains is present in the partition, - -- otherwise set to False. - procedure Gen_Adainit; -- Generates the Adainit procedure @@ -391,43 +376,6 @@ package body Bindgen is -- First writes its argument (using Set_String (S)), then writes out the -- contents of statement buffer up to Last, and reset Last to 0 - ------------------------------------ - -- Check_Dispatching_Domains_Used -- - ------------------------------------ - - procedure Check_Dispatching_Domains_Used is - begin - Check_File_In_Partition ("s-mudido.ads", Dispatching_Domains_Used); - end Check_Dispatching_Domains_Used; - - ----------------------------- - -- Check_File_In_Partition -- - ----------------------------- - - procedure Check_File_In_Partition - (File_Name : String; - Flag : out Boolean) - is - begin - for J in Units.First .. Units.Last loop - if Get_Name_String (Units.Table (J).Sfile) = File_Name then - Flag := True; - return; - end if; - end loop; - - Flag := False; - end Check_File_In_Partition; - - ------------------------------------ - -- Check_System_Restrictions_Used -- - ------------------------------------ - - procedure Check_System_Restrictions_Used is - begin - Check_File_In_Partition ("s-restri.ads", System_Restrictions_Used); - end Check_System_Restrictions_Used; - ------------------ -- Gen_Adafinal -- ------------------ @@ -2124,9 +2072,6 @@ package body Bindgen is -- Generate output file in appropriate language - Check_System_Restrictions_Used; - Check_Dispatching_Domains_Used; - Gen_Output_File_Ada (Filename); end Gen_Output_File; @@ -2869,6 +2814,23 @@ package body Bindgen is ---------------------------- procedure Resolve_Binder_Options is + procedure Check_Package (Var : in out Boolean; Name : String); + -- Set Var to true iff the current identifier in Namet is Name. + -- Do nothing if it doesn't match. This procedure is just an helper + -- to avoid to explicitely deal with length. + + ------------------- + -- Check_Package -- + ------------------- + + procedure Check_Package (Var : in out Boolean; Name : String) is + begin + if Name_Len = Name'Length + and then Name_Buffer (1 .. Name_Len) = Name + then + Var := True; + end if; + end Check_Package; begin for E in Elab_Order.First .. Elab_Order.Last loop Get_Name_String (Units.Table (Elab_Order.Table (E)).Uname); @@ -2878,21 +2840,29 @@ package body Bindgen is -- used: system.os_interface should always be used by any tasking -- application. - if Name_Buffer (1 .. 19) = "system.os_interface" then - With_GNARL := True; - end if; + Check_Package (With_GNARL, "system.os_interface%s"); -- Ditto for declib and the "dec" package - if OpenVMS_On_Target and then Name_Buffer (1 .. 5) = "dec%s" then - With_DECGNAT := True; + if OpenVMS_On_Target then + Check_Package (With_DECGNAT, "dec%s"); end if; - -- Likewise for the use of restricted tasking + -- Ditto for the use of restricted tasking - if Name_Buffer (1 .. 34) = "system.tasking.restricted.stages%s" then - System_Tasking_Restricted_Stages_Used := True; - end if; + Check_Package + (System_Tasking_Restricted_Stages_Used, + "system.tasking.restricted.stages%s"); + + -- Ditto for the use of dispatching domains + + Check_Package + (Dispatching_Domains_Used, + "system.multiprocessors.dispatching_domains%s"); + + -- Ditto for the use of restrictions + + Check_Package (System_Restrictions_Used, "system.restrictions%s"); end loop; end Resolve_Binder_Options; diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index af2e3e7..474429e 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -13912,10 +13912,13 @@ package body Exp_Ch9 is Prefix => Make_Identifier (Loc, New_External_Name (Tnam, 'E')), Attribute_Name => Name_Unchecked_Access)); - -- Chain parameter. This is a reference to the _Chain parameter of - -- the initialization procedure. + if not Restricted_Profile then + -- Chain parameter. This is a reference to the _Chain parameter of + -- the initialization procedure. There is no chain in restricted + -- profile. - Append_To (Args, Make_Identifier (Loc, Name_uChain)); + Append_To (Args, Make_Identifier (Loc, Name_uChain)); + end if; -- Task name parameter. Take this from the _Task_Id parameter to the -- init call unless there is a Task_Name pragma, in which case we take diff --git a/gcc/ada/g-sechas.adb b/gcc/ada/g-sechas.adb index 78eddc3..921ef3e 100644 --- a/gcc/ada/g-sechas.adb +++ b/gcc/ada/g-sechas.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2009-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -34,8 +34,6 @@ with Interfaces; use Interfaces; package body GNAT.Secure_Hashes is - use Ada.Streams; - Hex_Digit : constant array (Stream_Element range 0 .. 15) of Character := "0123456789abcdef"; diff --git a/gcc/ada/g-sechas.ads b/gcc/ada/g-sechas.ads index 7fe34b1..243bd60 100644 --- a/gcc/ada/g-sechas.ads +++ b/gcc/ada/g-sechas.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2009, Free Software Foundation, Inc. -- +-- Copyright (C) 2009-2012, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -36,7 +36,7 @@ -- This is an internal unit and should be not used directly in applications. -- Use GNAT.MD5 and GNAT.SHA* instead. -with Ada.Streams; +with Ada.Streams; use Ada.Streams; with Interfaces; with System; @@ -84,7 +84,7 @@ package GNAT.Secure_Hashes is procedure To_Hash (H : State; - H_Bits : out Ada.Streams.Stream_Element_Array); + H_Bits : out Stream_Element_Array); -- Convert H to stream representation with the given bit order. -- If H_Bits is smaller than the internal hash state, then the state -- is truncated. @@ -147,7 +147,7 @@ package GNAT.Secure_Hashes is procedure Wide_Update (C : in out Context; Input : Wide_String); procedure Update (C : in out Context; - Input : Ada.Streams.Stream_Element_Array); + Input : Stream_Element_Array); -- Update C to process the given input. Successive calls to Update are -- equivalent to a single call with the concatenation of the inputs. For -- the Wide_String version, each Wide_Character is processed low order @@ -166,8 +166,7 @@ package GNAT.Secure_Hashes is function Digest (S : String) return Message_Digest; function Wide_Digest (W : Wide_String) return Message_Digest; - function Digest - (A : Ada.Streams.Stream_Element_Array) return Message_Digest; + function Digest (A : Stream_Element_Array) return Message_Digest; -- These functions are equivalent to the corresponding Update (or -- Wide_Update) on a default initialized Context, followed by Digest -- on the resulting Context. diff --git a/gcc/ada/s-tarest.adb b/gcc/ada/s-tarest.adb index 1ff9b86..bba83ab 100644 --- a/gcc/ada/s-tarest.adb +++ b/gcc/ada/s-tarest.adb @@ -462,12 +462,9 @@ package body System.Tasking.Restricted.Stages is State : Task_Procedure_Access; Discriminants : System.Address; Elaborated : Access_Boolean; - Chain : in out Activation_Chain; Task_Image : String; Created_Task : Task_Id) is - pragma Unreferenced (Chain); - Self_ID : constant Task_Id := STPO.Self; Base_Priority : System.Any_Priority; Base_CPU : System.Multiprocessors.CPU_Range; diff --git a/gcc/ada/s-tarest.ads b/gcc/ada/s-tarest.ads index 9b52b61..af7030e 100644 --- a/gcc/ada/s-tarest.ads +++ b/gcc/ada/s-tarest.ads @@ -89,7 +89,7 @@ package System.Tasking.Restricted.Stages is -- create_restricted_task (unspecified_priority, tZ, -- unspecified_task_info, unspecified_cpu, -- task_procedure_access!(tB'address), _init'address, - -- tE'unchecked_access, _chain, _task_name, _init._task_id); + -- tE'unchecked_access, _task_name, _init._task_id); -- return; -- end tVIP; @@ -120,8 +120,6 @@ package System.Tasking.Restricted.Stages is -- t1S : constant String := "t1"; -- tIP (t1, 3, _chain, t1S, 1); - -- activate_restricted_tasks (_chain'unchecked_access); - procedure Create_Restricted_Task (Priority : Integer; Stack_Address : System.Address; @@ -131,7 +129,6 @@ package System.Tasking.Restricted.Stages is State : Task_Procedure_Access; Discriminants : System.Address; Elaborated : Access_Boolean; - Chain : in out Activation_Chain; Task_Image : String; Created_Task : Task_Id); -- Compiler interface only. Do not call from within the RTS. @@ -164,10 +161,6 @@ package System.Tasking.Restricted.Stages is -- Elaborated is a pointer to a Boolean that must be set to true on exit -- if the task could be successfully elaborated. -- - -- Chain is a linked list of task that needs to be created. On exit, - -- Created_Task.Activation_Link will be Chain.T_ID, and Chain.T_ID will be - -- Created_Task (the created task will be linked at the front of Chain). - -- -- Task_Image is a string created by the compiler that the run time can -- store to ease the debugging and the Ada.Task_Identification facility. -- diff --git a/gcc/ada/warnsw.adb b/gcc/ada/warnsw.adb index 7920ac9..3b42857 100644 --- a/gcc/ada/warnsw.adb +++ b/gcc/ada/warnsw.adb @@ -236,6 +236,7 @@ package body Warnsw is Warn_On_Record_Holes := False; Warn_On_Redundant_Constructs := True; Warn_On_Reverse_Bit_Order := False; + Warn_On_Standard_Redefinition := True; Warn_On_Suspicious_Contract := True; Warn_On_Unchecked_Conversion := True; Warn_On_Unordered_Enumeration_Type := False; -- 2.7.4