procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2004-02-25  Robert Dewar  <dewar@gnat.com>

	* 51osinte.ads, 52osinte.ads, 53osinte.ads, 54osinte.ads,
	55osinte.ads, 56osinte.ads, 5aosinte.ads, 5bosinte.ads,
	5cosinte.ads, 5fosinte.ads, 5gosinte.ads, 5hosinte.ads,
	5iosinte.ads, 5losinte.ads, 5nosinte.ads, 5oosinte.ads,
	5posinte.ads, 5sosinte.ads, 5tosinte.ads, 5vosinte.ads,
	5wosinte.ads, 5zosinte.ads: Move instances of Unchecked_Conversion to
	the defining instance of the type to avoid aliasing problems.
	Fix copyright header.  Fix bad comments in package header.

	* exp_util.adb, prj-part.adb, prj-part.adb: Minor reformatting

2004-02-25  Ed Schonberg  <schonberg@gnat.com>

	* exp_ch2.adb (Param_Entity): Handle properly formals that have been
	rewritten as references when aliased through an address clause.

	* sem_ch4.adb (Try_Indirect_Call): Normalize actuals before checking
	whether call can be interpreted as an indirect call to the result of a
	parameterless function call returning an access subprogram.

2004-02-25  Arnaud Charlet  <charlet@act-europe.fr>

	Code clean up:
	* exp_ch7.adb (Make_Clean): Remove generation of calls to
	Unlock[_Entries], since this is now done by Service_Entries directly.

	* exp_ch9.adb (Build_Protected_Subprogram_Body): ditto.

	* s-tpobop.ads, s-tpobop.adb (PO_Service_Entries): New nested procedure
	Requeue_Call for better code readability. Change spec and update calls:
	PO_Service_Entries now unlock the PO on exit.
	(Protected_Entry_Call, Timed_Protected_Entry_Call): Update calls to
	PO_Service_Entries.

	* s-tposen.ads, s-tposen.adb (Service_Entry): Now unlock the PO on exit.

	* s-taenca.adb, s-tasren.adb: Update calls to PO_Service_Entries.

2004-02-25  Sergey Rybin  <rybin@act-europe.fr>

	* exp_ch9.adb (Build_Simple_Entry_Call): Prevent expanding the
	protected subprogram call and analyzing the result of such expanding
	in case when the called protected subprogram is eliminated.

	* sem_elim.adb (Check_Eliminated): Skip blocks when comparing scope
	names.

2004-02-25  Jerome Guitton  <guitton@act-europe.fr>

	* Makefile.in: Clean ups.

From-SVN: r78436
This commit is contained in:
Arnaud Charlet 2004-02-25 16:59:05 +01:00
parent 4ab51fb500
commit 8a7988f51a
37 changed files with 545 additions and 332 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
gcc/ada/51osinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1999-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -31,16 +32,17 @@
-- --
------------------------------------------------------------------------------
-- This is a UnixWare (Native THREADS) version of this package.
-- This is a UnixWare (Native THREADS) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Unchecked_Conversion;
package System.OS_Interface is
pragma Preelaborate;
@ -243,6 +245,10 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
type pthread_t is private;
subtype Thread_Id is pthread_t;

17
gcc/ada/52osinte.ads
View file

@ -6,8 +6,8 @@
-- --
-- S p e c --
-- --
-- --
-- Copyright (C) 1999-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -32,16 +32,17 @@
-- --
------------------------------------------------------------------------------
-- This is a LynxOS (Native) version of this package.
-- This is a LynxOS (Native) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Unchecked_Conversion;
package System.OS_Interface is
pragma Preelaborate;
@ -246,6 +247,10 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
type pthread_t is private;
subtype Thread_Id is pthread_t;

19
gcc/ada/53osinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1999-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -31,16 +32,20 @@
-- --
------------------------------------------------------------------------------
-- This is a HPUX 11.0 (Native THREADS) version of this package.
-- This is a HPUX 11.0 (Native THREADS) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Unchecked_Conversion;
package System.OS_Interface is
pragma Preelaborate;
@ -247,6 +252,10 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
type pthread_t is private;
subtype Thread_Id is pthread_t;

16
gcc/ada/54osinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2000-2003 Ada Core Technologies, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -31,16 +32,17 @@
-- --
------------------------------------------------------------------------------
-- This is a Solaris (POSIX Threads) version of this package.
-- This is a Solaris (POSIX Threads) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Unchecked_Conversion;
package System.OS_Interface is
pragma Preelaborate;
@ -237,6 +239,10 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
type pthread_t is private;
subtype Thread_Id is pthread_t;

14
gcc/ada/55osinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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,7 +35,15 @@
-- This is the FreeBSD PTHREADS version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Unchecked_Conversion;
package System.OS_Interface is
pragma Preelaborate;
@ -269,6 +278,9 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
type pthread_t is private;
subtype Thread_Id is pthread_t;

16
gcc/ada/56osinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2002-2003 Ada Core Technologies, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -31,16 +32,17 @@
-- --
------------------------------------------------------------------------------
-- This is a LynxOS (POSIX Threads) version of this package.
-- This is a LynxOS (POSIX Threads) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Unchecked_Conversion;
package System.OS_Interface is
pragma Preelaborate;
@ -261,6 +263,10 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
type pthread_t is private;
subtype Thread_Id is pthread_t;

15
gcc/ada/5aosinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1998-2002 Free Software Foundation, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -31,15 +32,17 @@
-- --
------------------------------------------------------------------------------
-- This is the DEC Unix 4.0/5.1 version of this package.
-- This is the DEC Unix 4.0/5.1 version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Unchecked_Conversion;
package System.OS_Interface is
pragma Preelaborate;
@ -253,6 +256,10 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
type pthread_t is private;
subtype Thread_Id is pthread_t;

16
gcc/ada/5bosinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -31,16 +32,17 @@
-- --
------------------------------------------------------------------------------
-- This is a AIX (Native THREADS) version of this package.
-- This is a AIX (Native THREADS) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Unchecked_Conversion;
package System.OS_Interface is
pragma Preelaborate;
@ -252,6 +254,10 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
type pthread_t is private;
subtype Thread_Id is pthread_t;

16
gcc/ada/5cosinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1998-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -31,16 +32,17 @@
-- --
------------------------------------------------------------------------------
-- This is a AIX (FSU THREADS) version of this package.
-- This is a AIX (FSU THREADS) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Unchecked_Conversion;
package System.OS_Interface is
pragma Preelaborate;
-- pragma Elaborate_Body;
@ -246,6 +248,10 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
type pthread_t is private;
subtype Thread_Id is pthread_t;

16
gcc/ada/5fosinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1998-2001, Free Software Foundation, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -31,16 +32,17 @@
-- --
------------------------------------------------------------------------------
-- This is the SGI Pthreads version of this package.
-- This is the SGI Pthreads version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Unchecked_Conversion;
package System.OS_Interface is
pragma Preelaborate;
@ -242,6 +244,10 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
type pthread_t is private;
subtype Thread_Id is pthread_t;

14
gcc/ada/5gosinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2001 Free Software Foundation, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -31,18 +32,18 @@
-- --
------------------------------------------------------------------------------
-- This is an Irix (old pthread library) version of this package.
-- This is an Irix (old pthread library) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces;
with Interfaces.C;
with Interfaces.C.Strings;
with Unchecked_Conversion;
package System.OS_Interface is
@ -269,6 +270,9 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
type pthread_t is private; -- thread identifier
subtype Thread_Id is pthread_t;

15
gcc/ada/5hosinte.ads
View file

@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2003, Ada Core Technologies --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -32,16 +32,17 @@
-- --
------------------------------------------------------------------------------
-- This is the HP-UX version of this package.
-- This is the HP-UX version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Unchecked_Conversion;
package System.OS_Interface is
pragma Preelaborate;
@ -237,6 +238,10 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
type pthread_t is private;
subtype Thread_Id is pthread_t;

16
gcc/ada/5iosinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -31,16 +32,17 @@
-- --
------------------------------------------------------------------------------
-- This is a GNU/Linux (GNU/LinuxThreads) version of this package.
-- This is a GNU/Linux (GNU/LinuxThreads) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Unchecked_Conversion;
package System.OS_Interface is
pragma Preelaborate;
@ -267,6 +269,10 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
type pthread_t is private;
subtype Thread_Id is pthread_t;

14
gcc/ada/5losinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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,11 +37,12 @@
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Unchecked_Conversion;
package System.OS_Interface is
pragma Preelaborate;
@ -246,6 +248,10 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
type pthread_t is private;
subtype Thread_Id is pthread_t;

6
gcc/ada/5nosinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2002 Free Software Foundation, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -33,6 +34,9 @@
-- This is the no tasking version
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
package System.OS_Interface is
pragma Preelaborate;

9
gcc/ada/5oosinte.ads
View file

@ -7,7 +7,7 @@
-- S p e c --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2003, Ada Core Technologies --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -37,12 +37,11 @@
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Preelaborate.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
package System.OS_Interface is
pragma Preelaborate;

16
gcc/ada/5posinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -31,16 +32,17 @@
-- --
------------------------------------------------------------------------------
-- This is a OpenNT/Interix (FSU THREADS) version of this package.
-- This is a OpenNT/Interix (FSU THREADS) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Unchecked_Conversion;
package System.OS_Interface is
pragma Preelaborate;
@ -237,6 +239,10 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
type pthread_t is private;
subtype Thread_Id is pthread_t;

13
gcc/ada/5sosinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2002 Free Software Foundation, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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,11 +37,12 @@
-- This package includes all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Unchecked_Conversion;
package System.OS_Interface is
pragma Preelaborate;
@ -298,6 +300,9 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
THR_DETACHED : constant := 64;
THR_BOUND : constant := 1;
THR_NEW_LWP : constant := 2;

16
gcc/ada/5tosinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2003, Free Software Foundation, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -31,16 +32,17 @@
-- --
------------------------------------------------------------------------------
-- This is a Solaris (FSU THREADS) version of this package.
-- This is a Solaris (FSU THREADS) version of this package
-- This package includes all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Unchecked_Conversion;
package System.OS_Interface is
pragma Preelaborate;
@ -333,6 +335,10 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
type pthread_t is private;
subtype Thread_Id is pthread_t;

16
gcc/ada/5vosinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1991-2002 Free Software Foundation, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -31,16 +32,17 @@
-- --
------------------------------------------------------------------------------
-- This is a OpenVMS/Alpha version of this package.
-- This is a OpenVMS/Alpha version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Unchecked_Conversion;
package System.OS_Interface is
pragma Preelaborate;
@ -358,6 +360,10 @@ package System.OS_Interface is
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
type pthread_t is private;
subtype Thread_Id is pthread_t;

20
gcc/ada/5wosinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2003, Free Software Foundation, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -31,17 +32,17 @@
-- --
------------------------------------------------------------------------------
-- This is a NT (native) version of this package.
-- This is a NT (native) version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with Interfaces.C.Strings;
with Unchecked_Conversion;
package System.OS_Interface is
pragma Preelaborate;
@ -68,7 +69,8 @@ pragma Preelaborate;
subtype PSZ is Interfaces.C.Strings.chars_ptr;
subtype PCHAR is Interfaces.C.Strings.chars_ptr;
subtype PVOID is System.Address;
Null_Void : constant PVOID := System.Null_Address;
Null_Void : constant PVOID := System.Null_Address;
type PLONG is access all Interfaces.C.long;
type PDWORD is access all DWORD;
@ -185,6 +187,9 @@ pragma Preelaborate;
type Thread_Body is access
function (arg : System.Address) return System.Address;
function Thread_Body_Access is new
Unchecked_Conversion (System.Address, Thread_Body);
procedure SwitchToThread;
pragma Import (Stdcall, SwitchToThread, "SwitchToThread");
@ -216,6 +221,9 @@ pragma Preelaborate;
(pThreadParameter : PVOID) return DWORD;
pragma Convention (Stdcall, PTHREAD_START_ROUTINE);
function To_PTHREAD_START_ROUTINE is new
Unchecked_Conversion (System.Address, PTHREAD_START_ROUTINE);
type SECURITY_ATTRIBUTES is record
nLength : DWORD;
pSecurityDescriptor : PVOID;

15
gcc/ada/5zosinte.ads
View file

@ -6,7 +6,8 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1997-2002 Free Software Foundation, Inc. --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -31,19 +32,13 @@
-- --
------------------------------------------------------------------------------
-- This is the VxWorks version of this package.
--
-- VxWorks does not directly support the needed POSIX routines, but it
-- does have other routines that make it possible to code equivalent
-- POSIX compliant routines. The approach taken is to provide an
-- FSU threads compliant interface.
-- This is the VxWorks version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
-- PLEASE DO NOT add any with-clauses to this package
-- or remove the pragma Elaborate_Body.
-- It is designed to be a bottom-level (leaf) package.
-- PLEASE DO NOT add any with-clauses to this package or remove the pragma
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
with System.VxWorks;

53
gcc/ada/ChangeLog
View file

@ -1,3 +1,56 @@
2004-02-25 Robert Dewar <dewar@gnat.com>
* 51osinte.ads, 52osinte.ads, 53osinte.ads, 54osinte.ads,
55osinte.ads, 56osinte.ads, 5aosinte.ads, 5bosinte.ads,
5cosinte.ads, 5fosinte.ads, 5gosinte.ads, 5hosinte.ads,
5iosinte.ads, 5losinte.ads, 5nosinte.ads, 5oosinte.ads,
5posinte.ads, 5sosinte.ads, 5tosinte.ads, 5vosinte.ads,
5wosinte.ads, 5zosinte.ads: Move instances of Unchecked_Conversion to
the defining instance of the type to avoid aliasing problems.
Fix copyright header. Fix bad comments in package header.
* exp_util.adb, prj-part.adb, prj-part.adb: Minor reformatting
2004-02-25 Ed Schonberg <schonberg@gnat.com>
* exp_ch2.adb (Param_Entity): Handle properly formals that have been
rewritten as references when aliased through an address clause.
* sem_ch4.adb (Try_Indirect_Call): Normalize actuals before checking
whether call can be interpreted as an indirect call to the result of a
parameterless function call returning an access subprogram.
2004-02-25 Arnaud Charlet <charlet@act-europe.fr>
Code clean up:
* exp_ch7.adb (Make_Clean): Remove generation of calls to
Unlock[_Entries], since this is now done by Service_Entries directly.
* exp_ch9.adb (Build_Protected_Subprogram_Body): ditto.
* s-tpobop.ads, s-tpobop.adb (PO_Service_Entries): New nested procedure
Requeue_Call for better code readability. Change spec and update calls:
PO_Service_Entries now unlock the PO on exit.
(Protected_Entry_Call, Timed_Protected_Entry_Call): Update calls to
PO_Service_Entries.
* s-tposen.ads, s-tposen.adb (Service_Entry): Now unlock the PO on exit.
* s-taenca.adb, s-tasren.adb: Update calls to PO_Service_Entries.
2004-02-25 Sergey Rybin <rybin@act-europe.fr>
* exp_ch9.adb (Build_Simple_Entry_Call): Prevent expanding the
protected subprogram call and analyzing the result of such expanding
in case when the called protected subprogram is eliminated.
* sem_elim.adb (Check_Eliminated): Skip blocks when comparing scope
names.
2004-02-25 Jerome Guitton <guitton@act-europe.fr>
* Makefile.in: Clean ups.
2004-02-23 Ed Schonberg <schonberg@gnat.com>
* exp_ch6.adb (Expand_N_Subprogram_Declaration): Do not create

14
gcc/ada/Makefile.in
View file

@ -1382,6 +1382,7 @@ HIE_OBJS = \
s-fatflt.o \
s-fatlfl.o \
s-fatllf.o \
s-fatsfl.o \
s-secsta.o \
a-tags.o $(EXTRA_HIE_OBJS)
@ -1428,8 +1429,7 @@ RAVEN_SOURCES = $(NON_COMPILABLE_RAVEN_SOURCES) $(COMPILABLE_RAVEN_SOURCES)
# Objects to generate for the ravenscar run time
RAVEN_OBJS = \
$(HIE_OBJS) \
RAVEN_LIBGNARL_OBJS = \
s-parame.o \
s-purexc.o \
s-osinte.o \
@ -1442,6 +1442,7 @@ RAVEN_OBJS = \
a-intnam.o \
a-reatim.o \
a-retide.o \
s-osinte.o \
s-taprob.o \
s-tposen.o \
s-tasres.o \
@ -1449,6 +1450,10 @@ RAVEN_OBJS = \
a-sytaco.o \
a-taside.o $(EXTRA_RAVEN_OBJS)
RAVEN_OBJS = \
$(HIE_OBJS) \
$(RAVEN_LIBGNARL_OBJS)
# Default run time files
ADA_INCLUDE_SRCS =\
@ -1874,10 +1879,13 @@ rts-ravenscar: force
COMPILABLE_SOURCES="$(COMPILABLE_RAVEN_SOURCES)"
$(GNATMAKE) -Prts-ravenscar/ravenscar.gpr \
--GCC="../../../xgcc -B../../../"
cd rts-ravenscar/adalib/ ; $(AR) r libgnat.a *.o
cd rts-ravenscar/adalib ; \
$(foreach FILE,$(RAVEN_LIBGNARL_OBJS), $(AR) r libgnarl.a $(FILE);) \
$(foreach FILE,$(HIE_OBJS), $(AR) r libgnat.a $(FILE);)
$(RM) rts-ravenscar/adalib/*.o
$(CHMOD) a-wx rts-ravenscar/adalib/*.ali
$(CHMOD) a-wx rts-ravenscar/adalib/libgnat.a
$(CHMOD) a-wx rts-ravenscar/adalib/libgnarl.a
# Warning: this target assumes that LIBRARY_VERSION has been set correctly.
gnatlib-shared-default:

7
gcc/ada/exp_ch2.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004 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- --
@ -695,6 +695,8 @@ package body Exp_Ch2 is
-- where rec is a selector whose Entry_Formal link points to the formal
-- For a formal of a task entity, the formal is rewritten as a local
-- renaming.
-- In addition, a formal that is marked volatile because it is aliased
-- through an address clause is rewritten as dereference as well.
function Param_Entity (N : Node_Id) return Entity_Id is
begin
@ -723,6 +725,9 @@ package body Exp_Ch2 is
if Present (Entry_Formal (Entity (S))) then
return Entry_Formal (Entity (S));
end if;
elsif Nkind (Original_Node (N)) = N_Identifier then
return Param_Entity (Original_Node (N));
end if;
end;
end if;

82
gcc/ada/exp_ch7.adb
View file

@ -2193,7 +2193,6 @@ package body Exp_Ch7 is
Spec : Node_Id;
Name : Node_Id;
Param : Node_Id;
Unlock : Node_Id;
Param_Type : Entity_Id;
Pid : Entity_Id := Empty;
Cancel_Param : Entity_Id;
@ -2274,50 +2273,53 @@ package body Exp_Ch7 is
Selector_Name =>
Make_Identifier (Loc, Name_uObject)),
Attribute_Name => Name_Unchecked_Access))));
end if;
-- Unlock (_object._object'Access);
-- _object is the record used to implement the protected object.
-- It is a parameter to the protected subprogram.
-- If the protected object is controlled (i.e it has entries or
-- needs finalization for interrupt handling), call Unlock_Entries,
-- except if the protected object follows the ravenscar profile, in
-- which case call Unlock_Entry, otherwise call the simplified
-- version, Unlock.
if Has_Entries (Pid)
or else Has_Interrupt_Handler (Pid)
or else (Has_Attach_Handler (Pid) and then not Restricted_Profile)
then
if Abort_Allowed
or else Restriction_Active (No_Entry_Queue) = False
or else Number_Entries (Pid) > 1
then
Unlock := New_Reference_To (RTE (RE_Unlock_Entries), Loc);
else
Unlock := New_Reference_To (RTE (RE_Unlock_Entry), Loc);
end if;
else
Unlock := New_Reference_To (RTE (RE_Unlock), Loc);
-- Unlock (_object._object'Access);
-- object is the record used to implement the protected object.
-- It is a parameter to the protected subprogram.
-- If the protected object is controlled (i.e it has entries or
-- needs finalization for interrupt handling), call
-- Unlock_Entries, except if the protected object follows the
-- ravenscar profile, in which case call Unlock_Entry, otherwise
-- call the simplified version, Unlock.
if Has_Entries (Pid)
or else Has_Interrupt_Handler (Pid)
or else (Has_Attach_Handler (Pid)
and then not Restricted_Profile)
then
if Abort_Allowed
or else Restriction_Active (No_Entry_Queue) = False
or else Number_Entries (Pid) > 1
then
Name := New_Reference_To (RTE (RE_Unlock_Entries), Loc);
else
Name := New_Reference_To (RTE (RE_Unlock_Entry), Loc);
end if;
else
Name := New_Reference_To (RTE (RE_Unlock), Loc);
end if;
Append_To (Stmt,
Make_Procedure_Call_Statement (Loc,
Name => Name,
Parameter_Associations => New_List (
Make_Attribute_Reference (Loc,
Prefix =>
Make_Selected_Component (Loc,
Prefix =>
New_Reference_To (Defining_Identifier (Param), Loc),
Selector_Name =>
Make_Identifier (Loc, Name_uObject)),
Attribute_Name => Name_Unchecked_Access))));
end if;
Append_To (Stmt,
Make_Procedure_Call_Statement (Loc,
Name => Unlock,
Parameter_Associations => New_List (
Make_Attribute_Reference (Loc,
Prefix =>
Make_Selected_Component (Loc,
Prefix =>
New_Reference_To (Defining_Identifier (Param), Loc),
Selector_Name =>
Make_Identifier (Loc, Name_uObject)),
Attribute_Name => Name_Unchecked_Access))));
if Abort_Allowed then
-- Abort_Undefer;
Append_To (Stmt,

35
gcc/ada/exp_ch9.adb
View file

@ -1553,10 +1553,7 @@ package body Exp_Ch9 is
Sub_Body : Node_Id;
Lock_Name : Node_Id;
Lock_Stmt : Node_Id;
Unlock_Name : Node_Id;
Unlock_Stmt : Node_Id;
Service_Name : Node_Id;
Service_Stmt : Node_Id;
R : Node_Id;
Return_Stmt : Node_Id := Empty; -- init to avoid gcc 3 warning
Pre_Stmts : List_Id := No_List; -- init to avoid gcc 3 warning
@ -1740,19 +1737,16 @@ package body Exp_Ch9 is
or else Number_Entries (Pid) > 1
then
Lock_Name := New_Reference_To (RTE (RE_Lock_Entries), Loc);
Unlock_Name := New_Reference_To (RTE (RE_Unlock_Entries), Loc);
Service_Name := New_Reference_To (RTE (RE_Service_Entries), Loc);
else
Lock_Name := New_Reference_To (RTE (RE_Lock_Entry), Loc);
Unlock_Name := New_Reference_To (RTE (RE_Unlock_Entry), Loc);
Service_Name := New_Reference_To (RTE (RE_Service_Entry), Loc);
end if;
else
Lock_Name := New_Reference_To (RTE (RE_Lock), Loc);
Unlock_Name := New_Reference_To (RTE (RE_Unlock), Loc);
Service_Name := Empty;
Service_Name := New_Reference_To (RTE (RE_Unlock), Loc);
end if;
Object_Parm :=
@ -1790,20 +1784,12 @@ package body Exp_Ch9 is
Append (Unprot_Call, Stmts);
end if;
if Service_Name /= Empty then
Service_Stmt := Make_Procedure_Call_Statement (Loc,
Name => Service_Name,
Parameter_Associations =>
New_List (New_Copy_Tree (Object_Parm)));
Append (Service_Stmt, Stmts);
end if;
Unlock_Stmt :=
Append (
Make_Procedure_Call_Statement (Loc,
Name => Unlock_Name,
Parameter_Associations => New_List (
New_Copy_Tree (Object_Parm)));
Append (Unlock_Stmt, Stmts);
Name => Service_Name,
Parameter_Associations =>
New_List (New_Copy_Tree (Object_Parm))),
Stmts);
if Abort_Allowed then
Append (
@ -2040,9 +2026,12 @@ package body Exp_Ch9 is
if Is_Protected_Type (Conctyp)
and then Is_Subprogram (Entity (Ename))
then
Build_Protected_Subprogram_Call
(N, Ename, Convert_Concurrent (Concval, Conctyp));
Analyze (N);
if not Is_Eliminated (Entity (Ename)) then
Build_Protected_Subprogram_Call
(N, Ename, Convert_Concurrent (Concval, Conctyp));
Analyze (N);
end if;
return;
end if;

3
gcc/ada/exp_util.adb
View file

@ -3264,8 +3264,7 @@ package body Exp_Util is
N_In |
N_Not_In |
N_And_Then |
N_Or_Else
=>
N_Or_Else =>
return Side_Effect_Free (Left_Opnd (N))
and then Side_Effect_Free (Right_Opnd (N));

17
gcc/ada/prj-part.adb
View file

@ -100,7 +100,7 @@ package body Prj.Part is
type Names_And_Id is record
Path_Name : Name_Id;
Canonical_Path_Name : Name_Id;
Id : Project_Node_Id;
Id : Project_Node_Id;
end record;
package Project_Stack is new Table.Table
@ -763,10 +763,10 @@ package body Prj.Part is
for Index in 1 .. Project_Stack.Last loop
if Project_Stack.Table (Index).Canonical_Path_Name =
Canonical_Path_Name
Canonical_Path_Name
then
-- We have found the limited imported project,
-- get its project id, and don't parse it.
-- get its project id, and do not parse it.
Withed_Project := Project_Stack.Table (Index).Id;
exit;
@ -915,6 +915,7 @@ package body Prj.Part is
loop
declare
Path_Id : Name_Id := Path_Name_Of (A_Project_Name_And_Node.Node);
begin
if Path_Id /= No_Name then
Get_Name_String (Path_Id);
@ -947,10 +948,12 @@ package body Prj.Part is
if From_Extended /= None then
declare
Decl : Project_Node_Id :=
Project_Declaration_Of
(A_Project_Name_And_Node.Node);
Project_Declaration_Of
(A_Project_Name_And_Node.Node);
Prj : Project_Node_Id :=
Extending_Project_Of (Decl);
Extending_Project_Of (Decl);
begin
loop
Decl := Project_Declaration_Of (Prj);
@ -983,7 +986,7 @@ package body Prj.Part is
Source_Index := Load_Project_File (Path_Name);
Tree.Save (Project_Comment_State);
-- if we cannot find it, we stop
-- If we cannot find it, we stop
if Source_Index = No_Source_File then
Project := Empty_Node;

4
gcc/ada/s-taenca.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -470,7 +470,7 @@ package body System.Tasking.Entry_Calls is
STPO.Unlock (Entry_Call.Called_Task);
else
Called_PO := To_Protection (Entry_Call.Called_PO);
PO_Service_Entries (Self_ID, Called_PO);
PO_Service_Entries (Self_ID, Called_PO, False);
if Called_PO.Pending_Action then
Called_PO.Pending_Action := False;

4
gcc/ada/s-tasren.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2003, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -71,7 +71,6 @@ with System.Tasking.Protected_Objects.Operations;
-- used for PO_Do_Or_Queue
-- PO_Service_Entries
-- Lock_Entries
-- Unlock_Entries
with System.Tasking.Debug;
-- used for Trace
@ -678,7 +677,6 @@ package body System.Tasking.Rendezvous is
(Self_Id, Called_PO, Entry_Call,
Entry_Call.Requeue_With_Abort);
POO.PO_Service_Entries (Self_Id, Called_PO);
STPE.Unlock_Entries (Called_PO);
end if;
end if;

283
gcc/ada/s-tpobop.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2003, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -376,7 +376,6 @@ package body System.Tasking.Protected_Objects.Operations is
else
PO_Do_Or_Queue (Self_ID, New_Object, Entry_Call, With_Abort);
PO_Service_Entries (Self_ID, New_Object);
Unlock_Entries (New_Object);
end if;
else
@ -441,150 +440,168 @@ package body System.Tasking.Protected_Objects.Operations is
------------------------
procedure PO_Service_Entries
(Self_ID : Task_ID;
Object : Protection_Entries_Access)
(Self_ID : Task_ID;
Object : Entries.Protection_Entries_Access;
Unlock_Object : Boolean := True)
is
Entry_Call : Entry_Call_Link;
E : Protected_Entry_Index;
Caller : Task_ID;
New_Object : Protection_Entries_Access;
Ceiling_Violation : Boolean;
Result : Boolean;
procedure Requeue_Call
(Entry_Call : Entry_Call_Link;
Call_Cancelled : out Boolean);
-- Handle requeue of Entry_Call.
-- Call_Cancelled is set to True of call was cancelled.
------------------
-- Requeue_Call --
------------------
procedure Requeue_Call
(Entry_Call : Entry_Call_Link;
Call_Cancelled : out Boolean)
is
New_Object : Protection_Entries_Access;
Ceiling_Violation : Boolean;
Result : Boolean;
E : Protected_Entry_Index;
begin
Call_Cancelled := False;
New_Object := To_Protection (Entry_Call.Called_PO);
if New_Object = null then
-- Call is to be requeued to a task entry
if Single_Lock then
STPO.Lock_RTS;
end if;
Result := Rendezvous.Task_Do_Or_Queue
(Self_ID, Entry_Call,
With_Abort => Entry_Call.Requeue_With_Abort);
if not Result then
Queuing.Broadcast_Program_Error
(Self_ID, Object, Entry_Call, RTS_Locked => True);
end if;
if Single_Lock then
STPO.Unlock_RTS;
end if;
else
-- Call should be requeued to a PO
if Object /= New_Object then
-- Requeue is to different PO
Lock_Entries (New_Object, Ceiling_Violation);
if Ceiling_Violation then
Object.Call_In_Progress := null;
Queuing.Broadcast_Program_Error
(Self_ID, Object, Entry_Call);
else
PO_Do_Or_Queue (Self_ID, New_Object, Entry_Call,
Entry_Call.Requeue_With_Abort);
PO_Service_Entries (Self_ID, New_Object);
end if;
else
-- Requeue is to same protected object
if Entry_Call.Requeue_With_Abort
and then Entry_Call.Cancellation_Attempted
then
-- If this is a requeue with abort and someone tried
-- to cancel this call, cancel it at this point.
Entry_Call.State := Cancelled;
Call_Cancelled := True;
return;
end if;
if not Entry_Call.Requeue_With_Abort or else
Entry_Call.Mode /= Conditional_Call
then
E := Protected_Entry_Index (Entry_Call.E);
Queuing.Enqueue
(New_Object.Entry_Queues (E), Entry_Call);
Update_For_Queue_To_PO (Entry_Call,
Entry_Call.Requeue_With_Abort);
else
PO_Do_Or_Queue (Self_ID, New_Object, Entry_Call,
Entry_Call.Requeue_With_Abort);
end if;
end if;
end if;
end Requeue_Call;
E : Protected_Entry_Index;
Caller : Task_ID;
Entry_Call : Entry_Call_Link;
Cancelled : Boolean;
begin
loop
Queuing.Select_Protected_Entry_Call (Self_ID, Object, Entry_Call);
if Entry_Call /= null then
E := Protected_Entry_Index (Entry_Call.E);
exit when Entry_Call = null;
-- Not abortable while service is in progress.
E := Protected_Entry_Index (Entry_Call.E);
if Entry_Call.State = Now_Abortable then
Entry_Call.State := Was_Abortable;
-- Not abortable while service is in progress.
if Entry_Call.State = Now_Abortable then
Entry_Call.State := Was_Abortable;
end if;
Object.Call_In_Progress := Entry_Call;
begin
if Runtime_Traces then
Send_Trace_Info (PO_Run, Self_ID,
Entry_Call.Self, Entry_Index (E));
end if;
Object.Call_In_Progress := Entry_Call;
pragma Debug
(Debug.Trace (Self_ID, "POSE: start entry body", 'P'));
Object.Entry_Bodies (
Object.Find_Body_Index (Object.Compiler_Info, E)).Action (
Object.Compiler_Info, Entry_Call.Uninterpreted_Data, E);
exception
when others =>
Queuing.Broadcast_Program_Error
(Self_ID, Object, Entry_Call);
end;
begin
if Runtime_Traces then
Send_Trace_Info (PO_Run, Self_ID,
Entry_Call.Self, Entry_Index (E));
end if;
pragma Debug
(Debug.Trace (Self_ID, "POSE: start entry body", 'P'));
Object.Entry_Bodies (
Object.Find_Body_Index (Object.Compiler_Info, E)).Action (
Object.Compiler_Info, Entry_Call.Uninterpreted_Data, E);
exception
when others =>
Queuing.Broadcast_Program_Error
(Self_ID, Object, Entry_Call);
end;
if Object.Call_In_Progress /= null then
Object.Call_In_Progress := null;
Caller := Entry_Call.Self;
if Single_Lock then
STPO.Lock_RTS;
end if;
STPO.Write_Lock (Caller);
Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Done);
STPO.Unlock (Caller);
if Single_Lock then
STPO.Unlock_RTS;
end if;
else
-- Call needs to be requeued
New_Object := To_Protection (Entry_Call.Called_PO);
if New_Object = null then
-- Call is to be requeued to a task entry
if Single_Lock then
STPO.Lock_RTS;
end if;
Result := Rendezvous.Task_Do_Or_Queue
(Self_ID, Entry_Call,
With_Abort => Entry_Call.Requeue_With_Abort);
if not Result then
Queuing.Broadcast_Program_Error
(Self_ID, Object, Entry_Call, RTS_Locked => True);
end if;
if Single_Lock then
STPO.Unlock_RTS;
end if;
else
-- Call should be requeued to a PO
if Object /= New_Object then
-- Requeue is to different PO
Lock_Entries (New_Object, Ceiling_Violation);
if Ceiling_Violation then
Object.Call_In_Progress := null;
Queuing.Broadcast_Program_Error
(Self_ID, Object, Entry_Call);
else
PO_Do_Or_Queue (Self_ID, New_Object, Entry_Call,
Entry_Call.Requeue_With_Abort);
PO_Service_Entries (Self_ID, New_Object);
Unlock_Entries (New_Object);
end if;
else
-- Requeue is to same protected object
-- ??? Try to compensate apparent failure of the
-- scheduler on some OS (e.g VxWorks) to give higher
-- priority tasks a chance to run (see CXD6002).
STPO.Yield (False);
if Entry_Call.Requeue_With_Abort
and then Entry_Call.Cancellation_Attempted
then
-- If this is a requeue with abort and someone tried
-- to cancel this call, cancel it at this point.
Entry_Call.State := Cancelled;
exit;
end if;
if not Entry_Call.Requeue_With_Abort or else
Entry_Call.Mode /= Conditional_Call
then
E := Protected_Entry_Index (Entry_Call.E);
Queuing.Enqueue
(New_Object.Entry_Queues (E), Entry_Call);
Update_For_Queue_To_PO (Entry_Call,
Entry_Call.Requeue_With_Abort);
else
PO_Do_Or_Queue (Self_ID, New_Object, Entry_Call,
Entry_Call.Requeue_With_Abort);
end if;
end if;
end if;
end if;
if Object.Call_In_Progress = null then
Requeue_Call (Entry_Call, Cancelled);
exit when Cancelled;
else
exit;
Object.Call_In_Progress := null;
Caller := Entry_Call.Self;
if Single_Lock then
STPO.Lock_RTS;
end if;
STPO.Write_Lock (Caller);
Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Done);
STPO.Unlock (Caller);
if Single_Lock then
STPO.Unlock_RTS;
end if;
end if;
end loop;
if Unlock_Object then
Unlock_Entries (Object);
end if;
end PO_Service_Entries;
---------------------
@ -712,8 +729,6 @@ package body System.Tasking.Protected_Objects.Operations is
Initially_Abortable := Entry_Call.State = Now_Abortable;
PO_Service_Entries (Self_ID, Object);
Unlock_Entries (Object);
-- Try to prevent waiting later (in Cancel_Protected_Entry_Call)
-- for completed or cancelled calls. (This is a heuristic, only.)
@ -971,8 +986,6 @@ package body System.Tasking.Protected_Objects.Operations is
PO_Do_Or_Queue (Self_Id, Object, Entry_Call, With_Abort => True);
PO_Service_Entries (Self_Id, Object);
Unlock_Entries (Object);
-- Try to avoid waiting for completed or cancelled calls.
if Entry_Call.State >= Done then

9
gcc/ada/s-tpobop.ads
View file

@ -7,7 +7,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -95,19 +95,22 @@ package System.Tasking.Protected_Objects.Operations is
pragma Inline (Service_Entries);
procedure PO_Service_Entries
(Self_ID : Task_ID;
Object : Entries.Protection_Entries_Access);
(Self_ID : Task_ID;
Object : Entries.Protection_Entries_Access;
Unlock_Object : Boolean := True);
-- Service all entry queues of the specified object, executing the
-- corresponding bodies of any queued entry calls that are waiting
-- on True barriers. This is used when the state of a protected
-- object may have changed, in particular after the execution of
-- the statement sequence of a protected procedure.
--
-- Note that servicing an entry may change the value of one or more
-- barriers, so this routine keeps checking barriers until all of
-- them are closed.
--
-- This must be called with abortion deferred and with the corresponding
-- object locked.
-- If Unlock_Object, then Object is unlocked on return.
procedure Complete_Entry_Body (Object : Entries.Protection_Entries_Access);
-- Called from within an entry body procedure, indicates that the

7
gcc/ada/s-tposen.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1998-2002, Free Software Foundation, Inc. --
-- Copyright (C) 1998-2004, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -52,7 +52,7 @@ pragma Style_Checks (All_Checks);
-- mentioned above are respected, except for the No_Entry_Queue restriction
-- that is checked dynamically in this package, since the check cannot be
-- performed at compile time, and is relatively cheap (see PO_Do_Or_Queue,
-- PO_Service_Entry).
-- Service_Entry).
pragma Polling (Off);
-- Turn off polling, we do not want polling to take place during tasking
@ -530,6 +530,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is
-- Program_Error to the caller.
Send_Program_Error (Self_Id, Entry_Call);
Unlock_Entry (Object);
return;
end if;
@ -538,6 +539,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is
(Object.Compiler_Info, Entry_Call.Uninterpreted_Data, 1);
Object.Call_In_Progress := null;
Caller := Entry_Call.Self;
Unlock_Entry (Object);
if Single_Lock then
STPO.Lock_RTS;
@ -556,6 +558,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is
exception
when others =>
Send_Program_Error (Self_Id, Entry_Call);
Unlock_Entry (Object);
end Service_Entry;
---------------------------------------

7
gcc/ada/s-tposen.ads
View file

@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 1992-2003 Free Software Foundation, Inc. --
-- Copyright (C) 1992-2004 Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
@ -222,8 +222,9 @@ package System.Tasking.Protected_Objects.Single_Entry is
-- barrier. This is used when the state of a protected object may have
-- changed, in particular after the execution of the statement sequence of
-- a protected procedure.
-- This must be called with abortion deferred and with the corresponding
-- object locked.
--
-- This must be called with abort deferred and with the corresponding
-- object locked. Object is unlocked on return.
procedure Protected_Single_Entry_Call
(Object : Protection_Entry_Access;

6
gcc/ada/sem_ch4.adb
View file

@ -4317,13 +4317,15 @@ package body Sem_Ch4 is
Nam : Entity_Id;
Typ : Entity_Id) return Boolean
is
Actuals : constant List_Id := Parameter_Associations (N);
Actual : Node_Id;
Formal : Entity_Id;
Call_OK : Boolean;
begin
Actual := First (Actuals);
Normalize_Actuals (N, Designated_Type (Typ), False, Call_OK);
Actual := First_Actual (N);
Formal := First_Formal (Designated_Type (Typ));
while Present (Actual)
and then Present (Formal)
loop

15
gcc/ada/sem_elim.adb
View file

@ -289,8 +289,15 @@ package body Sem_Elim is
-- Then we need to see if the static scope matches within the
-- compilation unit.
-- At the moment, gnatelim does not consider block statements as
-- scopes (even if a block is named)
Scop := Scope (E);
while Ekind (Scop) = E_Block loop
Scop := Scope (Scop);
end loop;
if Elmt.Entity_Scope /= null then
for J in reverse Elmt.Entity_Scope'Range loop
if Elmt.Entity_Scope (J) /= Original_Chars (Scop) then
@ -299,6 +306,10 @@ package body Sem_Elim is
Scop := Scope (Scop);
while Ekind (Scop) = E_Block loop
Scop := Scope (Scop);
end loop;
if not Is_Compilation_Unit (Scop) and then J = 1 then
goto Continue;
end if;
@ -314,6 +325,10 @@ package body Sem_Elim is
Scop := Scope (Scop);
while Ekind (Scop) = E_Block loop
Scop := Scope (Scop);
end loop;
if Scop /= Standard_Standard and then J = 1 then
goto Continue;
end if;