Skip to content

R
riscv-gcc-1
Commit 0b5b2bbc by Arnaud Charlet
Options

[multiple changes] 

2011-09-15  Robert Dewar  <dewar@adacore.com>

	* a-cdlili.adb, a-coinve.adb, a-stzunb-shared.ads, a-suezst.adb,
	a-suenco.adb, a-stwiun-shared.ads, a-cobove.adb, a-convec.adb,
	a-btgbso.adb, a-cbdlli.adb, a-suewst.adb: Minor reformatting.

2011-09-15  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Expression_Function): Code cleanup:
	if the expression function is not a completion, create a
	new specification for the generated declaration, and keep the
	original specification in the generated body. Shorter code also
	ensures that proper warnings are generated for unused formals
	in all cases.

2011-09-15  Sergey Rybin  <rybin@adacore.com>

	* tree_io.ads: Update ASIS_Version_Number because of the changes
	in the tree structures for expression functions.

2011-09-15  Arnaud Charlet  <charlet@adacore.com>

	* s-osinte-aix.ads, s-osinte-darwin.ads, s-osinte-freebsd.ads,
	s-osinte-hpux.ads, s-osinte-lynxos.ads, s-osinte-solaris-posix.ads,
	s-taprop-posix.adb (CLOCK_MONOTONIC): New constant.
	(CLOCK_REALTIME): Fix wrong value on some OSes.
	* s-taprop-posix.adb (Monotonic_Clock): Use CLOCK_MONOTONIC.

From-SVN: r178877
parent 21f1e8ce
Showing with 191 additions and 141 deletions
gcc/ada/ChangeLog
2011-09-15 Robert Dewar <dewar@adacore.com>
* a-cdlili.adb, a-coinve.adb, a-stzunb-shared.ads, a-suezst.adb,
a-suenco.adb, a-stwiun-shared.ads, a-cobove.adb, a-convec.adb,
a-btgbso.adb, a-cbdlli.adb, a-suewst.adb: Minor reformatting.
2011-09-15 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Analyze_Expression_Function): Code cleanup:
if the expression function is not a completion, create a
new specification for the generated declaration, and keep the
original specification in the generated body. Shorter code also
ensures that proper warnings are generated for unused formals
in all cases.
2011-09-15 Sergey Rybin <rybin@adacore.com>
* tree_io.ads: Update ASIS_Version_Number because of the changes
in the tree structures for expression functions.
2011-09-15 Arnaud Charlet <charlet@adacore.com>
* s-osinte-aix.ads, s-osinte-darwin.ads, s-osinte-freebsd.ads,
s-osinte-hpux.ads, s-osinte-lynxos.ads, s-osinte-solaris-posix.ads,
s-taprop-posix.adb (CLOCK_MONOTONIC): New constant.
(CLOCK_REALTIME): Fix wrong value on some OSes.
* s-taprop-posix.adb (Monotonic_Clock): Use CLOCK_MONOTONIC.
2011-09-11 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/utils.c (maybe_unconstrained_array): In the reference
......
gcc/ada/a-btgbso.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2004-2010, Free Software Foundation, Inc. --
-- Copyright (C) 2004-2011, 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- --
......@@ -546,11 +546,10 @@ package body Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations is
"attempt to tamper with cursors (container is busy)";
end if;
-- Note that there's no way to decide a priori whether the
-- target has enough capacity for the union with source.
-- We cannot simply compare the sum of the existing lengths
-- to the capacity of the target, because equivalent items
-- from source are not included in the union.
-- Note that there's no way to decide a priori whether the target has
-- enough capacity for the union with source. We cannot simply compare
-- the sum of the existing lengths to the capacity of the target,
-- because equivalent items from source are not included in the union.
Iterate (Source);
end Set_Union;
......
gcc/ada/a-cbdlli.adb
......@@ -582,52 +582,52 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
-- The list container actually contains two lists: one for the "active"
-- nodes that contain elements that have been inserted onto the list,
-- and another for the "inactive" nodes for the free store.
--
-- We desire that merely declaring an object should have only minimal
-- cost; specially, we want to avoid having to initialize the free
-- store (to fill in the links), especially if the capacity is large.
--
-- The head of the free list is indicated by Container.Free. If its
-- value is non-negative, then the free store has been initialized
-- in the "normal" way: Container.Free points to the head of the list
-- of free (inactive) nodes, and the value 0 means the free list is
-- empty. Each node on the free list has been initialized to point
-- to the next free node (via its Next component), and the value 0
-- means that this is the last free node.
--
-- If Container.Free is negative, then the links on the free store
-- have not been initialized. In this case the link values are
-- implied: the free store comprises the components of the node array
-- started with the absolute value of Container.Free, and continuing
-- until the end of the array (Nodes'Last).
--
-- If the list container is manipulated on one end only (for example
-- if the container were being used as a stack), then there is no
-- need to initialize the free store, since the inactive nodes are
-- physically contiguous (in fact, they lie immediately beyond the
-- logical end being manipulated). The only time we need to actually
-- initialize the nodes in the free store is if the node that becomes
-- inactive is not at the end of the list. The free store would then
-- be discontiguous and so its nodes would need to be linked in the
-- traditional way.
--
-- value is non-negative, then the free store has been initialized in
-- the "normal" way: Container.Free points to the head of the list of
-- free (inactive) nodes, and the value 0 means the free list is empty.
-- Each node on the free list has been initialized to point to the next
-- free node (via its Next component), and the value 0 means that this
-- is the last free node.
-- If Container.Free is negative, then the links on the free store have
-- not been initialized. In this case the link values are implied: the
-- free store comprises the components of the node array started with
-- the absolute value of Container.Free, and continuing until the end of
-- the array (Nodes'Last).
-- If the list container is manipulated on one end only (for example if
-- the container were being used as a stack), then there is no need to
-- initialize the free store, since the inactive nodes are physically
-- contiguous (in fact, they lie immediately beyond the logical end
-- being manipulated). The only time we need to actually initialize the
-- nodes in the free store is if the node that becomes inactive is not
-- at the end of the list. The free store would then be discontiguous
-- and so its nodes would need to be linked in the traditional way.
-- ???
-- It might be possible to perform an optimization here. Suppose that
-- the free store can be represented as having two parts: one
-- comprising the non-contiguous inactive nodes linked together
-- in the normal way, and the other comprising the contiguous
-- inactive nodes (that are not linked together, at the end of the
-- nodes array). This would allow us to never have to initialize
-- the free store, except in a lazy way as nodes become inactive.
-- When an element is deleted from the list container, its node
-- becomes inactive, and so we set its Prev component to a negative
-- value, to indicate that it is now inactive. This provides a useful
-- way to detect a dangling cursor reference.
-- the free store can be represented as having two parts: one comprising
-- the non-contiguous inactive nodes linked together in the normal way,
-- and the other comprising the contiguous inactive nodes (that are not
-- linked together, at the end of the nodes array). This would allow us
-- to never have to initialize the free store, except in a lazy way as
-- nodes become inactive.
-- When an element is deleted from the list container, its node becomes
-- inactive, and so we set its Prev component to a negative value, to
-- indicate that it is now inactive. This provides a useful way to
-- detect a dangling cursor reference.
N (X).Prev := -1; -- Node is deallocated (not on active list)
if Container.Free >= 0 then
-- The free store has previously been initialized. All we need to
-- do here is link the newly-free'd node onto the free list.
......@@ -635,11 +635,12 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
Container.Free := X;
elsif X + 1 = abs Container.Free then
-- The free store has not been initialized, and the node becoming
-- inactive immediately precedes the start of the free store. All
-- we need to do is move the start of the free store back by one.
N (X).Next := 0; -- Not strictly necessary, but marginally safer
N (X).Next := 0; -- not strictly necessary, but marginally safer
Container.Free := Container.Free + 1;
else
......@@ -650,11 +651,10 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
-- node onto the head of the free store.
-- ???
-- See the comments above for an optimization opportunity. If
-- the next link for a node on the free store is negative, then
-- this means the remaining nodes on the free store are
-- physically contiguous, starting as the absolute value of
-- that index value.
-- See the comments above for an optimization opportunity. If the
-- next link for a node on the free store is negative, then this
-- means the remaining nodes on the free store are physically
-- contiguous, starting as the absolute value of that index value.
Container.Free := abs Container.Free;
......@@ -689,7 +689,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
Node : Count_Type := Container.First;
begin
for I in 2 .. Container.Length loop
for J in 2 .. Container.Length loop
if Nodes (Nodes (Node).Next).Element < Nodes (Node).Element then
return False;
end if;
......@@ -766,17 +766,20 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
N : Node_Array renames Container.Nodes;
procedure Partition (Pivot, Back : Count_Type);
-- What does this do ???
procedure Sort (Front, Back : Count_Type);
-- Internal procedure, what does it do??? rename it???
---------------
-- Partition --
---------------
procedure Partition (Pivot, Back : Count_Type) is
Node : Count_Type := N (Pivot).Next;
Node : Count_Type;
begin
Node := N (Pivot).Next;
while Node /= Back loop
if N (Node).Element < N (Pivot).Element then
declare
......@@ -2066,21 +2069,21 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
return False;
end if;
if Position.Node = L.First then -- eliminates earlier disjunct
-- Eliminate earlier disjunct
if Position.Node = L.First then
return True;
end if;
-- If we get here, we know, per disjunctive syllogism (modus
-- tollendo ponens), that this predicate is true:
-- N (Position.Node).Prev /= 0
-- If we get here, we know (disjunctive syllogism) that this
-- predicate is true: N (Position.Node).Prev /= 0
if Position.Node = L.Last then -- eliminates earlier disjunct
return True;
end if;
-- If we get here, we know, per disjunctive syllogism (modus
-- tollendo ponens), that this predicate is true:
-- N (Position.Node).Next /= 0
-- If we get here, we know (disjunctive syllogism) that this
-- predicate is true: N (Position.Node).Next /= 0
if N (N (Position.Node).Next).Prev /= Position.Node then
return False;
......
gcc/ada/a-cdlili.adb
......@@ -1890,21 +1890,23 @@ package body Ada.Containers.Doubly_Linked_Lists is
return False;
end if;
if Position.Node = L.First then -- eliminates earlier disjunct
-- Eliminate earlier disjunct
if Position.Node = L.First then
return True;
end if;
-- If we get here, we know, per disjunctive syllogism (modus
-- tollendo ponens), that this predicate is true:
-- Position.Node.Prev /= null
-- If we get here, we know (disjunctive syllogism) that this
-- predicate is true: Position.Node.Prev /= null
-- Eliminate earlier disjunct
if Position.Node = L.Last then -- eliminates earlier disjunct
if Position.Node = L.Last then
return True;
end if;
-- If we get here, we know, per disjunctive syllogism (modus
-- tollendo ponens), that this predicate is true:
-- Position.Node.Next /= null
-- If we get here, we know (disjunctive syllogism) that this
-- predicate is true: Position.Node.Next /= null
if Position.Node.Next.Prev /= Position.Node then
return False;
......
gcc/ada/a-cobove.adb
......@@ -1394,8 +1394,8 @@ package body Ada.Containers.Bounded_Vectors is
-- There are two constraints we need to satisfy. The first constraint is
-- that a container cannot have more than Count_Type'Last elements, so
-- we must check the sum of the current length and the insertion
-- count. Note that we cannot simply add these values, because of the
-- we must check the sum of the current length and the insertion count.
-- Note that we cannot simply add these values, because of the
-- possibility of overflow.
if Old_Length > Count_Type'Last - Count then
......
gcc/ada/a-convec.adb
......@@ -1022,9 +1022,9 @@ package body Ada.Containers.Vectors is
-- There are two constraints we need to satisfy. The first constraint is
-- that a container cannot have more than Count_Type'Last elements, so
-- we must check the sum of the current length and the insertion
-- count. Note that we cannot simply add these values, because of the
-- possibility of overflow.
-- we must check the sum of the current length and the insertion count.
-- Note: we cannot simply add these values, because of the possibility
-- of overflow.
if Old_Length > Count_Type'Last - Count then
raise Constraint_Error with "Count is out of range";
......@@ -1130,7 +1130,6 @@ package body Ada.Containers.Vectors is
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
New_Last := No_Index + Index_Type'Base (New_Length);
else
New_Last := Index_Type'Base (Count_Type'Base (No_Index) + New_Length);
end if;
......@@ -1690,9 +1689,9 @@ package body Ada.Containers.Vectors is
-- There are two constraints we need to satisfy. The first constraint is
-- that a container cannot have more than Count_Type'Last elements, so
-- we must check the sum of the current length and the insertion
-- count. Note that we cannot simply add these values, because of the
-- possibility of overflow.
-- we must check the sum of the current length and the insertion count.
-- Note: we cannot simply add these values, because of the possibility
-- of overflow.
if Old_Length > Count_Type'Last - Count then
raise Constraint_Error with "Count is out of range";
......
gcc/ada/a-stwiun-shared.ads
......@@ -410,10 +410,10 @@ private
type Shared_Wide_String (Max_Length : Natural) is limited record
Counter : System.Atomic_Counters.Atomic_Counter;
-- Reference counter.
-- Reference counter
Last : Natural := 0;
Data : Wide_String (1 .. Max_Length);
Last : Natural := 0;
Data : Wide_String (1 .. Max_Length);
-- Last is the index of last significant element of the Data. All
-- elements with larger indices are just an extra room.
end record;
......@@ -424,8 +424,7 @@ private
-- Increment reference counter.
procedure Unreference (Item : not null Shared_Wide_String_Access);
-- Decrement reference counter. Deallocate Item when reference counter is
-- zero.
-- Decrement reference counter. Deallocate Item when ref counter is zero
function Can_Be_Reused
(Item : Shared_Wide_String_Access;
......@@ -445,7 +444,7 @@ private
function To_Unbounded (S : Wide_String) return Unbounded_Wide_String
renames To_Unbounded_Wide_String;
-- This renames are here only to be used in the pragma Stream_Convert.
-- This renames are here only to be used in the pragma Stream_Convert
type Unbounded_Wide_String is new AF.Controlled with record
Reference : Shared_Wide_String_Access := Empty_Shared_Wide_String'Access;
......@@ -453,22 +452,25 @@ private
-- The Unbounded_Wide_String uses several techniques to increase speed of
-- the application:
-- - implicit sharing or copy-on-write. Unbounded_Wide_String contains
-- only the reference to the data which is shared between several
-- instances. The shared data is reallocated only when its value is
-- changed and the object mutation can't be used or it is inefficient to
-- use it;
-- - object mutation. Shared data object can be reused without memory
-- reallocation when all of the following requirements are meat:
-- - shared data object don't used anywhere longer;
-- - its size is sufficient to store new value;
-- - the gap after reuse is less then some threshold.
-- - memory preallocation. Most of used memory allocation algorithms
-- aligns allocated segment on the some boundary, thus some amount of
-- additional memory can be preallocated without any impact. Such
-- preallocated memory can used later by Append/Insert operations
-- without reallocation.
--
-- Reference counting uses GCC builtin atomic operations, which allows to
-- safely share internal data between Ada tasks. Nevertheless, this not
-- make objects of Unbounded_Wide_String thread-safe, so each instance
......@@ -485,7 +487,8 @@ private
overriding procedure Finalize (Object : in out Unbounded_Wide_String);
Null_Unbounded_Wide_String : constant Unbounded_Wide_String :=
(AF.Controlled with
Reference => Empty_Shared_Wide_String'Access);
(AF.Controlled with
Reference =>
Empty_Shared_Wide_String'Access);
end Ada.Strings.Wide_Unbounded;
gcc/ada/a-stzunb-shared.ads
......@@ -419,10 +419,10 @@ private
type Shared_Wide_Wide_String (Max_Length : Natural) is limited record
Counter : System.Atomic_Counters.Atomic_Counter;
-- Reference counter.
-- Reference counter
Last : Natural := 0;
Data : Wide_Wide_String (1 .. Max_Length);
Last : Natural := 0;
Data : Wide_Wide_String (1 .. Max_Length);
-- Last is the index of last significant element of the Data. All
-- elements with larger indices are just an extra room.
end record;
......@@ -466,22 +466,25 @@ private
-- The Unbounded_Wide_Wide_String uses several techniques to increase speed
-- of the application:
-- - implicit sharing or copy-on-write. Unbounded_Wide_Wide_String
-- contains only the reference to the data which is shared between
-- several instances. The shared data is reallocated only when its value
-- is changed and the object mutation can't be used or it is inefficient
-- to use it;
-- - object mutation. Shared data object can be reused without memory
-- reallocation when all of the following requirements are meat:
-- - shared data object don't used anywhere longer;
-- - its size is sufficient to store new value;
-- - the gap after reuse is less then some threshold.
-- - memory preallocation. Most of used memory allocation algorithms
-- aligns allocated segment on the some boundary, thus some amount of
-- additional memory can be preallocated without any impact. Such
-- preallocated memory can used later by Append/Insert operations
-- without reallocation.
--
-- Reference counting uses GCC builtin atomic operations, which allows to
-- safely share internal data between Ada tasks. Nevertheless, this not
-- make objects of Unbounded_Wide_Wide_String thread-safe, so each instance
......@@ -502,8 +505,9 @@ private
(Object : in out Unbounded_Wide_Wide_String);
Null_Unbounded_Wide_Wide_String : constant Unbounded_Wide_Wide_String :=
(AF.Controlled with
Reference =>
Empty_Shared_Wide_Wide_String'Access);
(AF.Controlled with
Reference =>
Empty_Shared_Wide_Wide_String'
Access);
end Ada.Strings.Wide_Wide_Unbounded;
gcc/ada/a-suenco.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2010, Free Software Foundation, Inc. --
-- Copyright (C) 2010-2011, 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- --
......@@ -92,10 +92,10 @@ package body Ada.Strings.UTF_Encoding.Conversions is
-- Output UTF-16 code
procedure Get_Continuation;
-- Reads a continuation byte of the form 10xxxxxx, shifts R left
-- by 6 bits, and or's in the xxxxxx to the low order 6 bits. On
-- return Ptr is incremented. Raises exception if continuation
-- byte does not exist or is invalid.
-- Reads a continuation byte of the form 10xxxxxx, shifts R left by 6
-- bits, and or's in the xxxxxx to the low order 6 bits. On return Ptr
-- is incremented. Raises exception if continuation byte does not exist
-- or is invalid.
----------------------
-- Get_Continuation --
......@@ -114,8 +114,8 @@ package body Ada.Strings.UTF_Encoding.Conversions is
Raise_Encoding_Error (Iptr - 1);
else
R := Shift_Left (R, 6) or
Unsigned_16 (C and 2#00_111111#);
R :=
Shift_Left (R, 6) or Unsigned_16 (C and 2#00_111111#);
end if;
end if;
end Get_Continuation;
......
gcc/ada/a-suewst.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2010, Free Software Foundation, Inc. --
-- Copyright (C) 2010-2011, 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- --
......@@ -66,10 +66,10 @@ package body Ada.Strings.UTF_Encoding.Wide_Strings is
R : Unsigned_16;
procedure Get_Continuation;
-- Reads a continuation byte of the form 10xxxxxx, shifts R left
-- by 6 bits, and or's in the xxxxxx to the low order 6 bits. On
-- return Ptr is incremented. Raises exception if continuation
-- byte does not exist or is invalid.
-- Reads a continuation byte of the form 10xxxxxx, shifts R left by 6
-- bits, and or's in the xxxxxx to the low order 6 bits. On return Ptr
-- is incremented. Raises exception if continuation byte does not exist
-- or is invalid.
----------------------
-- Get_Continuation --
......
gcc/ada/a-suezst.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2010, Free Software Foundation, Inc. --
-- Copyright (C) 2010-2011, 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- --
......@@ -66,10 +66,10 @@ package body Ada.Strings.UTF_Encoding.Wide_Wide_Strings is
R : Unsigned_32;
procedure Get_Continuation;
-- Reads a continuation byte of the form 10xxxxxx, shifts R left
-- by 6 bits, and or's in the xxxxxx to the low order 6 bits. On
-- return Ptr is incremented. Raises exception if continuation
-- byte does not exist or is invalid.
-- Reads a continuation byte of the form 10xxxxxx, shifts R left by 6
-- bits, and or's in the xxxxxx to the low order 6 bits. On return Ptr
-- is incremented. Raises exception if continuation byte does not exist
-- or is invalid.
----------------------
-- Get_Continuation --
......
gcc/ada/s-osinte-aix.ads
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2011, 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- --
......@@ -199,7 +199,8 @@ package System.OS_Interface is
type clockid_t is private;
CLOCK_REALTIME : constant clockid_t;
CLOCK_REALTIME : constant clockid_t;
CLOCK_MONOTONIC : constant clockid_t;
function clock_gettime
(clock_id : clockid_t;
......@@ -539,7 +540,8 @@ private
pragma Convention (C, timespec);
type clockid_t is new int;
CLOCK_REALTIME : constant clockid_t := 0;
CLOCK_REALTIME : constant clockid_t := 9;
CLOCK_MONOTONIC : constant clockid_t := 10;
type pthread_attr_t is new System.Address;
pragma Convention (C, pthread_attr_t);
......
gcc/ada/s-osinte-darwin.ads
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2011, 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- --
......@@ -185,7 +185,8 @@ package System.OS_Interface is
type clockid_t is private;
CLOCK_REALTIME : constant clockid_t;
CLOCK_REALTIME : constant clockid_t;
CLOCK_MONOTONIC : constant clockid_t;
function clock_gettime
(clock_id : clockid_t;
......@@ -516,7 +517,8 @@ private
pragma Convention (C, timespec);
type clockid_t is new int;
CLOCK_REALTIME : constant clockid_t := 0;
CLOCK_REALTIME : constant clockid_t := 0;
CLOCK_MONOTONIC : constant clockid_t := CLOCK_REALTIME;
--
-- Darwin specific signal implementation
......
gcc/ada/s-osinte-freebsd.ads
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2011, 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- --
......@@ -202,7 +202,8 @@ package System.OS_Interface is
type clockid_t is private;
CLOCK_REALTIME : constant clockid_t;
CLOCK_REALTIME : constant clockid_t;
CLOCK_MONOTONIC : constant clockid_t;
function clock_gettime
(clock_id : clockid_t;
......@@ -635,7 +636,8 @@ private
pragma Convention (C, timespec);
type clockid_t is new int;
CLOCK_REALTIME : constant clockid_t := 0;
CLOCK_REALTIME : constant clockid_t := 0;
CLOCK_MONOTONIC : constant clockid_t := 4;
type pthread_t is new System.Address;
type pthread_attr_t is new System.Address;
......
gcc/ada/s-osinte-hpux.ads
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2011, 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- --
......@@ -182,7 +182,8 @@ package System.OS_Interface is
type clockid_t is private;
CLOCK_REALTIME : constant clockid_t;
CLOCK_REALTIME : constant clockid_t;
CLOCK_MONOTONIC : constant clockid_t;
function clock_gettime
(clock_id : clockid_t;
......@@ -521,7 +522,8 @@ private
pragma Convention (C, timespec);
type clockid_t is new int;
CLOCK_REALTIME : constant clockid_t := 1;
CLOCK_REALTIME : constant clockid_t := 1;
CLOCK_MONOTONIC : constant clockid_t := CLOCK_REALTIME;
type pthread_attr_t is new int;
type pthread_condattr_t is new int;
......
gcc/ada/s-osinte-lynxos.ads
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2011, 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- --
......@@ -199,7 +199,8 @@ package System.OS_Interface is
type clockid_t is private;
CLOCK_REALTIME : constant clockid_t;
CLOCK_REALTIME : constant clockid_t;
CLOCK_MONOTONIC : constant clockid_t;
function clock_gettime
(clock_id : clockid_t;
......@@ -517,7 +518,8 @@ private
pragma Convention (C, timespec);
type clockid_t is new unsigned_char;
CLOCK_REALTIME : constant clockid_t := 0;
CLOCK_REALTIME : constant clockid_t := 1;
CLOCK_MONOTONIC : constant clockid_t := CLOCK_REALTIME;
type st_attr_t is record
stksize : int;
......
gcc/ada/s-osinte-solaris-posix.ads
......@@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2010, Free Software Foundation, Inc. --
-- Copyright (C) 1995-2011, 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- --
......@@ -189,7 +189,8 @@ package System.OS_Interface is
type clockid_t is private;
CLOCK_REALTIME : constant clockid_t;
CLOCK_REALTIME : constant clockid_t;
CLOCK_MONOTONIC : constant clockid_t;
function clock_gettime
(clock_id : clockid_t;
......@@ -512,7 +513,8 @@ private
pragma Convention (C, timespec);
type clockid_t is new int;
CLOCK_REALTIME : constant clockid_t := 0;
CLOCK_REALTIME : constant clockid_t := 3;
CLOCK_MONOTONIC : constant clockid_t := CLOCK_REALTIME;
type pthread_attr_t is record
pthread_attrp : System.Address;
......
gcc/ada/s-taprop-posix.adb
......@@ -666,7 +666,7 @@ package body System.Task_Primitives.Operations is
Result : Interfaces.C.int;
begin
Result := clock_gettime
(clock_id => CLOCK_REALTIME, tp => TS'Unchecked_Access);
(clock_id => CLOCK_MONOTONIC, tp => TS'Unchecked_Access);
pragma Assert (Result = 0);
return To_Duration (TS);
end Monotonic_Clock;
......
gcc/ada/sem_ch6.adb
......@@ -268,6 +268,7 @@ package body Sem_Ch6 is
Loc : constant Source_Ptr := Sloc (N);
LocX : constant Source_Ptr := Sloc (Expression (N));
Def_Id : constant Entity_Id := Defining_Entity (Specification (N));
Expr : constant Node_Id := Expression (N);
New_Body : Node_Id;
New_Decl : Node_Id;
......@@ -315,31 +316,28 @@ package body Sem_Ch6 is
Set_Is_Inlined (Prev);
Analyze (N);
-- If this is not a completion, create both a declaration and a body,
-- so that the expression can be inlined whenever possible.
-- If this is not a completion, create both a declaration and a body, so
-- that the expression can be inlined whenever possible. The spec of the
-- new subprogram declaration is a copy of the original specification,
-- which is now part of the subprogram body.
else
New_Decl :=
Make_Subprogram_Declaration (Loc,
Specification => Specification (N));
Specification => Copy_Separate_Tree (Specification (N)));
Rewrite (N, New_Decl);
Analyze (N);
Set_Is_Inlined (Defining_Entity (New_Decl));
-- Create new set of formals for specification in body.
Set_Specification (New_Body,
Make_Function_Specification (Loc,
Defining_Unit_Name =>
Make_Defining_Identifier (Loc, Chars (Defining_Entity (N))),
Parameter_Specifications =>
Copy_Parameter_List (Defining_Entity (New_Decl)),
Result_Definition =>
New_Copy_Tree (Result_Definition (Specification (New_Decl)))));
Insert_After (N, New_Body);
Analyze (New_Body);
end if;
-- If the return expression is a static constant, we suppress warning
-- messages on unused formals, which in most cases will be noise.
Set_Is_Trivial_Subprogram (Defining_Entity (New_Body),
Is_OK_Static_Expression (Expr));
end Analyze_Expression_Function;
----------------------------------------
......
gcc/ada/tree_io.ads
......@@ -47,12 +47,14 @@ package Tree_IO is
Tree_Format_Error : exception;
-- Raised if a format error is detected in the input file
ASIS_Version_Number : constant := 26;
ASIS_Version_Number : constant := 27;
-- 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
-- format that would result in the compiler being incompatible with an
-- older version of ASIS.
--
-- 27 2011-09-06 Changes in the tree structures for expression functions
procedure Tree_Read_Initialize (Desc : File_Descriptor);
-- Called to initialize reading of a tree file. This call must be made
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment