From 8a7988f51a78c05841fad17683cbb94b9dc33fd0 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 25 Feb 2004 16:59:05 +0100 Subject: [PATCH] [multiple changes] 2004-02-25 Robert Dewar * 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 * 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 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 * 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 * Makefile.in: Clean ups. From-SVN: r78436 --- gcc/ada/51osinte.ads | 16 ++- gcc/ada/52osinte.ads | 17 ++- gcc/ada/53osinte.ads | 19 +++- gcc/ada/54osinte.ads | 16 ++- gcc/ada/55osinte.ads | 14 ++- gcc/ada/56osinte.ads | 16 ++- gcc/ada/5aosinte.ads | 15 ++- gcc/ada/5bosinte.ads | 16 ++- gcc/ada/5cosinte.ads | 16 ++- gcc/ada/5fosinte.ads | 16 ++- gcc/ada/5gosinte.ads | 14 ++- gcc/ada/5hosinte.ads | 15 ++- gcc/ada/5iosinte.ads | 16 ++- gcc/ada/5losinte.ads | 14 ++- gcc/ada/5nosinte.ads | 6 +- gcc/ada/5oosinte.ads | 9 +- gcc/ada/5posinte.ads | 16 ++- gcc/ada/5sosinte.ads | 13 ++- gcc/ada/5tosinte.ads | 16 ++- gcc/ada/5vosinte.ads | 16 ++- gcc/ada/5wosinte.ads | 20 +++- gcc/ada/5zosinte.ads | 15 +-- gcc/ada/ChangeLog | 53 +++++++++ gcc/ada/Makefile.in | 14 ++- gcc/ada/exp_ch2.adb | 7 +- gcc/ada/exp_ch7.adb | 70 ++++++------ gcc/ada/exp_ch9.adb | 35 ++---- gcc/ada/exp_util.adb | 3 +- gcc/ada/prj-part.adb | 17 +-- gcc/ada/s-taenca.adb | 4 +- gcc/ada/s-tasren.adb | 4 +- gcc/ada/s-tpobop.adb | 253 +++++++++++++++++++++++-------------------- gcc/ada/s-tpobop.ads | 9 +- gcc/ada/s-tposen.adb | 7 +- gcc/ada/s-tposen.ads | 7 +- gcc/ada/sem_ch4.adb | 6 +- gcc/ada/sem_elim.adb | 15 +++ 37 files changed, 524 insertions(+), 311 deletions(-) diff --git a/gcc/ada/51osinte.ads b/gcc/ada/51osinte.ads index 509aee8ccd0..efc55eb54d5 100644 --- a/gcc/ada/51osinte.ads +++ b/gcc/ada/51osinte.ads @@ -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; diff --git a/gcc/ada/52osinte.ads b/gcc/ada/52osinte.ads index b6f30233193..71607a408a6 100644 --- a/gcc/ada/52osinte.ads +++ b/gcc/ada/52osinte.ads @@ -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; diff --git a/gcc/ada/53osinte.ads b/gcc/ada/53osinte.ads index 6ade0986762..95b093ae7fa 100644 --- a/gcc/ada/53osinte.ads +++ b/gcc/ada/53osinte.ads @@ -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; diff --git a/gcc/ada/54osinte.ads b/gcc/ada/54osinte.ads index cced53c4fc6..b5ad0af3877 100644 --- a/gcc/ada/54osinte.ads +++ b/gcc/ada/54osinte.ads @@ -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; diff --git a/gcc/ada/55osinte.ads b/gcc/ada/55osinte.ads index 581870c63f7..13e545871c1 100644 --- a/gcc/ada/55osinte.ads +++ b/gcc/ada/55osinte.ads @@ -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; diff --git a/gcc/ada/56osinte.ads b/gcc/ada/56osinte.ads index 3d7ff038f59..8b6b33885d1 100644 --- a/gcc/ada/56osinte.ads +++ b/gcc/ada/56osinte.ads @@ -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; diff --git a/gcc/ada/5aosinte.ads b/gcc/ada/5aosinte.ads index f84484ccb63..dc01b058343 100644 --- a/gcc/ada/5aosinte.ads +++ b/gcc/ada/5aosinte.ads @@ -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; diff --git a/gcc/ada/5bosinte.ads b/gcc/ada/5bosinte.ads index 9d43a19bc93..c761eb8a048 100644 --- a/gcc/ada/5bosinte.ads +++ b/gcc/ada/5bosinte.ads @@ -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; diff --git a/gcc/ada/5cosinte.ads b/gcc/ada/5cosinte.ads index 3dfe47d2f24..7ea96a83299 100644 --- a/gcc/ada/5cosinte.ads +++ b/gcc/ada/5cosinte.ads @@ -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; diff --git a/gcc/ada/5fosinte.ads b/gcc/ada/5fosinte.ads index ef3f9941d0a..92c11070dad 100644 --- a/gcc/ada/5fosinte.ads +++ b/gcc/ada/5fosinte.ads @@ -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; diff --git a/gcc/ada/5gosinte.ads b/gcc/ada/5gosinte.ads index 17cf4505965..e6df06813d7 100644 --- a/gcc/ada/5gosinte.ads +++ b/gcc/ada/5gosinte.ads @@ -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; diff --git a/gcc/ada/5hosinte.ads b/gcc/ada/5hosinte.ads index 379f0dc0a20..18de527be15 100644 --- a/gcc/ada/5hosinte.ads +++ b/gcc/ada/5hosinte.ads @@ -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; diff --git a/gcc/ada/5iosinte.ads b/gcc/ada/5iosinte.ads index 4dceebfac96..7b5de13b92c 100644 --- a/gcc/ada/5iosinte.ads +++ b/gcc/ada/5iosinte.ads @@ -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; diff --git a/gcc/ada/5losinte.ads b/gcc/ada/5losinte.ads index 8ca3d616072..df7a4322bf5 100644 --- a/gcc/ada/5losinte.ads +++ b/gcc/ada/5losinte.ads @@ -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; diff --git a/gcc/ada/5nosinte.ads b/gcc/ada/5nosinte.ads index 20b4d9de1fc..f33370dd43d 100644 --- a/gcc/ada/5nosinte.ads +++ b/gcc/ada/5nosinte.ads @@ -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; diff --git a/gcc/ada/5oosinte.ads b/gcc/ada/5oosinte.ads index 450a6064bfa..4ddd2d0b06d 100644 --- a/gcc/ada/5oosinte.ads +++ b/gcc/ada/5oosinte.ads @@ -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; diff --git a/gcc/ada/5posinte.ads b/gcc/ada/5posinte.ads index 57f04a82c17..4e5d9567df3 100644 --- a/gcc/ada/5posinte.ads +++ b/gcc/ada/5posinte.ads @@ -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; diff --git a/gcc/ada/5sosinte.ads b/gcc/ada/5sosinte.ads index a9bc30c2aa4..eaba6c8d567 100644 --- a/gcc/ada/5sosinte.ads +++ b/gcc/ada/5sosinte.ads @@ -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; diff --git a/gcc/ada/5tosinte.ads b/gcc/ada/5tosinte.ads index eaaf4e584df..14caf4e3ddd 100644 --- a/gcc/ada/5tosinte.ads +++ b/gcc/ada/5tosinte.ads @@ -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; diff --git a/gcc/ada/5vosinte.ads b/gcc/ada/5vosinte.ads index 2a14f44c979..333e02a37b8 100644 --- a/gcc/ada/5vosinte.ads +++ b/gcc/ada/5vosinte.ads @@ -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; diff --git a/gcc/ada/5wosinte.ads b/gcc/ada/5wosinte.ads index 8a74f50d14b..eec2e6ead98 100644 --- a/gcc/ada/5wosinte.ads +++ b/gcc/ada/5wosinte.ads @@ -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; diff --git a/gcc/ada/5zosinte.ads b/gcc/ada/5zosinte.ads index fb14fa0762f..7888cc18e68 100644 --- a/gcc/ada/5zosinte.ads +++ b/gcc/ada/5zosinte.ads @@ -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; diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7ecb98ec534..b26caea850a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,56 @@ +2004-02-25 Robert Dewar + + * 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 + + * 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 + + 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 + + * 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 + + * Makefile.in: Clean ups. + 2004-02-23 Ed Schonberg * exp_ch6.adb (Expand_N_Subprogram_Declaration): Do not create diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in index 53df983cc7b..f8df3945c92 100644 --- a/gcc/ada/Makefile.in +++ b/gcc/ada/Makefile.in @@ -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: diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb index f4aed89e28a..f7cf1abc16e 100644 --- a/gcc/ada/exp_ch2.adb +++ b/gcc/ada/exp_ch2.adb @@ -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; diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 2a683a27d55..e78d9954082 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -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); + else + -- Unlock (_object._object'Access); - -- _object is the record used to implement the protected object. - -- It is a parameter to the protected subprogram. + -- 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 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 + if Has_Entries (Pid) + or else Has_Interrupt_Handler (Pid) + or else (Has_Attach_Handler (Pid) + and then not Restricted_Profile) then - Unlock := New_Reference_To (RTE (RE_Unlock_Entries), Loc); + 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 - Unlock := New_Reference_To (RTE (RE_Unlock_Entry), Loc); + Name := New_Reference_To (RTE (RE_Unlock), Loc); end if; - else - Unlock := New_Reference_To (RTE (RE_Unlock), Loc); + 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, diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index ddaf2aa13e8..62ed2af0c5d 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -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; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 1abb7a2ba43..ba88516f485 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -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)); diff --git a/gcc/ada/prj-part.adb b/gcc/ada/prj-part.adb index a6c8f7b8f31..d9a3797ccaf 100644 --- a/gcc/ada/prj-part.adb +++ b/gcc/ada/prj-part.adb @@ -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; diff --git a/gcc/ada/s-taenca.adb b/gcc/ada/s-taenca.adb index db99abcbe3e..63b78d05205 100644 --- a/gcc/ada/s-taenca.adb +++ b/gcc/ada/s-taenca.adb @@ -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; diff --git a/gcc/ada/s-tasren.adb b/gcc/ada/s-tasren.adb index 67e437d6458..7d0a0ae736e 100644 --- a/gcc/ada/s-tasren.adb +++ b/gcc/ada/s-tasren.adb @@ -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; diff --git a/gcc/ada/s-tpobop.adb b/gcc/ada/s-tpobop.adb index 275f872de9a..cf15ed9f88a 100644 --- a/gcc/ada/s-tpobop.adb +++ b/gcc/ada/s-tpobop.adb @@ -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. - begin - loop - Queuing.Select_Protected_Entry_Call (Self_ID, Object, Entry_Call); + ------------------ + -- 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 Entry_Call /= null then - E := Protected_Entry_Index (Entry_Call.E); + if New_Object = null then - -- Not abortable while service is in progress. + -- Call is to be requeued to a task entry - if Entry_Call.State = Now_Abortable then - Entry_Call.State := Was_Abortable; + if Single_Lock then + STPO.Lock_RTS; end if; - Object.Call_In_Progress := Entry_Call; + Result := Rendezvous.Task_Do_Or_Queue + (Self_ID, Entry_Call, + With_Abort => Entry_Call.Requeue_With_Abort); - begin - if Runtime_Traces then - Send_Trace_Info (PO_Run, Self_ID, - Entry_Call.Self, Entry_Index (E)); - end if; + 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 - 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 => + -- 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); - end; - if Object.Call_In_Progress /= null then - Object.Call_In_Progress := null; - Caller := Entry_Call.Self; - - if Single_Lock then - STPO.Lock_RTS; + 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; - STPO.Write_Lock (Caller); - Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Done); - STPO.Unlock (Caller); + else + -- Requeue is to same protected object - if Single_Lock then - STPO.Unlock_RTS; + 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; - else - -- Call needs to be requeued + 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; - New_Object := To_Protection (Entry_Call.Called_PO); + E : Protected_Entry_Index; + Caller : Task_ID; + Entry_Call : Entry_Call_Link; + Cancelled : Boolean; - if New_Object = null then + begin + loop + Queuing.Select_Protected_Entry_Call (Self_ID, Object, Entry_Call); - -- Call is to be requeued to a task entry + exit when Entry_Call = null; - if Single_Lock then - STPO.Lock_RTS; - end if; + E := Protected_Entry_Index (Entry_Call.E); - Result := Rendezvous.Task_Do_Or_Queue - (Self_ID, Entry_Call, - With_Abort => Entry_Call.Requeue_With_Abort); + -- Not abortable while service is in progress. - if not Result then - Queuing.Broadcast_Program_Error - (Self_ID, Object, Entry_Call, RTS_Locked => True); - end if; + if Entry_Call.State = Now_Abortable then + Entry_Call.State := Was_Abortable; + end if; - if Single_Lock then - STPO.Unlock_RTS; - end if; + Object.Call_In_Progress := Entry_Call; - 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; + 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 + 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 diff --git a/gcc/ada/s-tpobop.ads b/gcc/ada/s-tpobop.ads index a4748ac0845..2e2ba0dfb98 100644 --- a/gcc/ada/s-tpobop.ads +++ b/gcc/ada/s-tpobop.ads @@ -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 diff --git a/gcc/ada/s-tposen.adb b/gcc/ada/s-tposen.adb index 3eaec425e91..b1a3ef29a4b 100644 --- a/gcc/ada/s-tposen.adb +++ b/gcc/ada/s-tposen.adb @@ -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; --------------------------------------- diff --git a/gcc/ada/s-tposen.ads b/gcc/ada/s-tposen.ads index cb581ff34b0..6ad90c7fe64 100644 --- a/gcc/ada/s-tposen.ads +++ b/gcc/ada/s-tposen.ads @@ -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; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index dad301aa2d5..c96450a107a 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -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 diff --git a/gcc/ada/sem_elim.adb b/gcc/ada/sem_elim.adb index 2a6ead46f56..8d380024b06 100644 --- a/gcc/ada/sem_elim.adb +++ b/gcc/ada/sem_elim.adb @@ -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; -- 2.30.2