-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
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;
-- --
-- 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- --
-- 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;
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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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
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;
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
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;
-- --
-- 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- --
-- 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;
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;
-- --
-- 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- --
-- 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;
-- 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- --
-- 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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
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;
-- --
-- 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- --
-- 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;
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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
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;
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");
(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;
-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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;
+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
s-fatflt.o \
s-fatlfl.o \
s-fatllf.o \
+ s-fatsfl.o \
s-secsta.o \
a-tags.o $(EXTRA_HIE_OBJS)
# Objects to generate for the ravenscar run time
-RAVEN_OBJS = \
- $(HIE_OBJS) \
+RAVEN_LIBGNARL_OBJS = \
s-parame.o \
s-purexc.o \
s-osinte.o \
a-intnam.o \
a-reatim.o \
a-retide.o \
+ s-osinte.o \
s-taprob.o \
s-tposen.o \
s-tasres.o \
a-sytaco.o \
a-taside.o $(EXTRA_RAVEN_OBJS)
+RAVEN_OBJS = \
+ $(HIE_OBJS) \
+ $(RAVEN_LIBGNARL_OBJS)
+
# Default run time files
ADA_INCLUDE_SRCS =\
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:
-- --
-- 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- --
-- 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
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;
Spec : Node_Id;
Name : Node_Id;
Param : Node_Id;
- Unlock : Node_Id;
Param_Type : Entity_Id;
Pid : Entity_Id := Empty;
Cancel_Param : Entity_Id;
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,
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
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 :=
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 (
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;
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));
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
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;
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);
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);
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;
-- --
-- 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- --
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;
-- --
-- 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- --
-- used for PO_Do_Or_Queue
-- PO_Service_Entries
-- Lock_Entries
--- Unlock_Entries
with System.Tasking.Debug;
-- used for Trace
(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;
-- --
-- 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- --
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
------------------------
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;
---------------------
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.)
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
-- --
-- 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- --
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
-- --
-- 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- --
-- 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
-- Program_Error to the caller.
Send_Program_Error (Self_Id, Entry_Call);
+ Unlock_Entry (Object);
return;
end if;
(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;
exception
when others =>
Send_Program_Error (Self_Id, Entry_Call);
+ Unlock_Entry (Object);
end Service_Entry;
---------------------------------------
-- --
-- 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- --
-- 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;
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
-- 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
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;
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;
OSDN Git Service
