+2012-10-29 Robert Dewar <dewar@adacore.com>
+
+ * warnsw.adb: Complete previous change.
+
+2012-10-29 Tristan Gingold <gingold@adacore.com>
+
+ * 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 <gingold@adacore.com>
+
+ * 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 <obry@adacore.com>
+
+ * g-sechas.adb, g-sechas.ads: Minor code clean-up.
+
2012-10-29 Ed Schonberg <schonberg@adacore.com>
* sem_aux.adb (Get_Rep_Item): Treat Priority and Interrupt_Priority
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
-- 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
-- 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 --
------------------
-- Generate output file in appropriate language
- Check_System_Restrictions_Used;
- Check_Dispatching_Domains_Used;
-
Gen_Output_File_Ada (Filename);
end Gen_Output_File;
----------------------------
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);
-- 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;
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
-- --
-- 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- --
package body GNAT.Secure_Hashes is
- use Ada.Streams;
-
Hex_Digit : constant array (Stream_Element range 0 .. 15) of Character :=
"0123456789abcdef";
-- --
-- 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- --
-- 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;
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.
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
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.
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;
-- 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;
-- 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;
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.
-- 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.
--
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;
projects / gcc.git / commitdiff