------------------------------------------------------------------------------ -- -- -- FLORIST (FSU Implementation of POSIX.5) COMPONENTS -- -- -- -- P O S I X . M U T E X E S -- -- -- -- B o d y -- -- -- -- -- -- Copyright (c) 1996, 2002 Florida State University (FSU), -- -- All Rights Reserved. -- -- -- -- This file is a component of FLORIST, an implementation of an Ada API -- -- for the POSIX OS services, for use with the GNAT Ada compiler and -- -- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended -- -- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD -- -- 1003.5b: 1996. -- -- -- -- FLORIST is free software; you can redistribute it and/or modify it -- -- under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 2, or (at your option) any -- -- later version. FLORIST is distributed in the hope that it will be -- -- useful, but WITHOUT ANY WARRANTY; without even the implied warranty -- -- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- -- General Public License for more details. You should have received a -- -- copy of the GNU General Public License distributed with GNARL; see -- -- file COPYING. If not, write to the Free Software Foundation, 59 -- -- Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from this -- -- unit, or you link this unit with other files to produce an executable, -- -- this unit does not by itself cause the resulting executable to be -- -- covered by the GNU General Public License. This exception does not -- -- however invalidate any other reasons why the executable file might be -- -- covered by the GNU Public License. -- -- -- ------------------------------------------------------------------------------ -- [$Revision: 1.3 $] with POSIX.C, POSIX.Implementation; package body POSIX.Mutexes is use POSIX.C; use POSIX.Implementation; type Mutexattr_Descriptor is access constant pthread_mutexattr_t; ------------------ -- Initialize -- ------------------ function pthread_mutexattr_init (attr : access pthread_mutexattr_t) return int; pragma Import (C, pthread_mutexattr_init, pthread_mutexattr_init_LINKNAME); procedure Initialize (Attr : in out Attributes) is begin Check_NZ (pthread_mutexattr_init (Attr.Attr'Unchecked_Access)); end Initialize; ---------------- -- Finalize -- ---------------- function pthread_mutexattr_destroy (attr : access pthread_mutexattr_t) return int; pragma Import (C, pthread_mutexattr_destroy, pthread_mutexattr_destroy_LINKNAME); procedure Finalize (Attr : in out Attributes) is begin Check_NZ (pthread_mutexattr_destroy (Attr.Attr'Unchecked_Access)); end Finalize; -------------------------- -- Get_Process_Shared -- -------------------------- function pthread_mutexattr_getpshared (attr : Mutexattr_Descriptor; pshared : access int) return int; pragma Import (C, pthread_mutexattr_getpshared, pthread_mutexattr_getpshared_LINKNAME); function Get_Process_Shared (Attr : Attributes) return Boolean is Result : aliased int; begin Check_NZ (pthread_mutexattr_getpshared (Attr.Attr'Unchecked_Access, Result'Unchecked_Access)); return Result = PTHREAD_PROCESS_SHARED; end Get_Process_Shared; -------------------------- -- Set_Process_Shared -- -------------------------- function pthread_mutexattr_setpshared (attr : access pthread_mutexattr_t; pshared : int) return int; pragma Import (C, pthread_mutexattr_setpshared, pthread_mutexattr_setpshared_LINKNAME); To_pshared : constant array (Boolean) of int := (True => PTHREAD_PROCESS_SHARED, False => PTHREAD_PROCESS_PRIVATE); procedure Set_Process_Shared (Attr : in out Attributes; Is_Shared : in Boolean := False) is begin Check_NZ (pthread_mutexattr_setpshared (Attr.Attr'Unchecked_Access, To_pshared (Is_Shared))); end Set_Process_Shared; -------------------------- -- Set_Locking_Policy -- -------------------------- function pthread_mutexattr_setprotocol (attr : access pthread_mutexattr_t; protocol : int) return int; pragma Import (C, pthread_mutexattr_setprotocol, pthread_mutexattr_setprotocol_LINKNAME); To_C_Policy : constant array (Locking_Policy) of int := (No_Priority_Inheritance => PTHREAD_PRIO_NONE, Highest_Blocked_Task => PTHREAD_PRIO_INHERIT, Highest_Ceiling_Priority => PTHREAD_PRIO_PROTECT); procedure Set_Locking_Policy (Attr : in out Attributes; Locking : in Locking_Policy) is begin Check_NZ (pthread_mutexattr_setprotocol (Attr.Attr'Unchecked_Access, To_C_Policy (Locking))); end Set_Locking_Policy; -------------------------- -- Get_Locking_Policy -- -------------------------- function pthread_mutexattr_getprotocol (attr : Mutexattr_Descriptor; value_ptr : access int) return int; pragma Import (C, pthread_mutexattr_getprotocol, pthread_mutexattr_getprotocol_LINKNAME); function Get_Locking_Policy (Attr : Attributes) return Locking_Policy is Result : aliased int; begin Check_NZ (pthread_mutexattr_getprotocol (Attr.Attr'Unchecked_Access, Result'Unchecked_Access)); if Result = PTHREAD_PRIO_NONE then return No_Priority_Inheritance; elsif Result = PTHREAD_PRIO_INHERIT then return Highest_Blocked_Task; elsif Result = PTHREAD_PRIO_PROTECT then return Highest_Ceiling_Priority; else Raise_POSIX_Error (Operation_Not_Supported); -- to suppress compiler warning return No_Priority_Inheritance; end if; end Get_Locking_Policy; ---------------------------- -- Set_Ceiling_Priority -- ---------------------------- function pthread_mutexattr_setprioceiling (attr : access pthread_mutexattr_t; prioceiling : int) return int; pragma Import (C, pthread_mutexattr_setprioceiling, pthread_mutexattr_setprioceiling_LINKNAME); procedure Set_Ceiling_Priority (Attr : in out Attributes; New_Ceiling : in Ceiling_Priority) is begin Check_NZ (pthread_mutexattr_setprioceiling (Attr.Attr'Unchecked_Access, int (New_Ceiling))); end Set_Ceiling_Priority; ---------------------------- -- Get_Ceiling_Priority -- ---------------------------- function pthread_mutexattr_getprioceiling (attr : Mutexattr_Descriptor; prioceiling : access int) return int; pragma Import (C, pthread_mutexattr_getprioceiling, pthread_mutexattr_getprioceiling_LINKNAME); function Get_Ceiling_Priority (Attr : Attributes) return Ceiling_Priority is Result : aliased int; begin Check_NZ (pthread_mutexattr_getprioceiling (Attr.Attr'Unchecked_Access, Result'Unchecked_Access)); return (Ceiling_Priority (Result)); end Get_Ceiling_Priority; ------------------ -- Initialize -- ------------------ function pthread_mutex_init (mutex : access pthread_mutex_t; attr : Mutexattr_Descriptor) return int; pragma Import (C, pthread_mutex_init, pthread_mutex_init_LINKNAME); procedure Initialize (M : in out Mutex; Attr : in Attributes) is begin Check_NZ (pthread_mutex_init (M.Mutex'Unchecked_Access, Attr.Attr'Unchecked_Access)); end Initialize; procedure Initialize (M : in out Mutex) is begin Check_NZ (pthread_mutex_init (M.Mutex'Unchecked_Access, null)); end Initialize; --------------------- -- Descriptor_Of -- --------------------- function Descriptor_Of (M : Mutex) return Mutex_Descriptor is begin return M.Mutex'Unchecked_Access; end Descriptor_Of; ---------------- -- Finalize -- ---------------- function pthread_mutex_destroy (mutex : access pthread_mutex_t) return int; pragma Import (C, pthread_mutex_destroy, pthread_mutex_destroy_LINKNAME); procedure Finalize (M : in out Mutex) is begin Check_NZ (pthread_mutex_destroy (M.Mutex'Unchecked_Access)); end Finalize; ---------------------------- -- Set_Ceiling_Priority -- ---------------------------- type int_ptr is access all int; function pthread_mutex_setprioceiling (mutex : Mutex_Descriptor; prioceiling : int; old_ceiling : int_ptr) return int; pragma Import (C, pthread_mutex_setprioceiling, pthread_mutex_setprioceiling_LINKNAME); procedure Set_Ceiling_Priority (M : in Mutex_Descriptor; New_Ceiling : in Ceiling_Priority; Old_Ceiling : out Ceiling_Priority) is Result : aliased int; begin Check_NZ (pthread_mutex_setprioceiling (M, int (New_Ceiling), Result'Unchecked_Access)); Old_Ceiling := Ceiling_Priority (Result); end Set_Ceiling_Priority; ---------------------------- -- Get_Ceiling_Priority -- ---------------------------- function pthread_mutex_getprioceiling (mutex : Mutex_Descriptor; prioceiling : access int) return int; pragma Import (C, pthread_mutex_getprioceiling, pthread_mutex_getprioceiling_LINKNAME); function Get_Ceiling_Priority (M : Mutex_Descriptor) return Ceiling_Priority is Result : aliased int; begin Check_NZ (pthread_mutex_getprioceiling (M, Result'Unchecked_Access)); return Ceiling_Priority (Result); end Get_Ceiling_Priority; ------------ -- Lock -- ------------ function pthread_mutex_lock (mutex : Mutex_Descriptor) return int; pragma Import (C, pthread_mutex_lock, pthread_mutex_lock_LINKNAME); procedure Lock (M : in Mutex_Descriptor) is begin Check_NZ (pthread_mutex_lock (M)); end Lock; ---------------- -- Try_Lock -- ---------------- function pthread_mutex_trylock (mutex : Mutex_Descriptor) return int; pragma Import (C, pthread_mutex_trylock, pthread_mutex_trylock_LINKNAME); function Try_Lock (M : Mutex_Descriptor) return Boolean is Result : int; begin Result := pthread_mutex_trylock (M); if Result = 0 then return True; elsif Fetch_Errno = EBUSY then return False; else Raise_POSIX_Error; -- return statement to suppress compiler warning message return False; end if; end Try_Lock; -------------- -- Unlock -- -------------- function pthread_mutex_unlock (mutex : Mutex_Descriptor) return int; pragma Import (C, pthread_mutex_unlock, pthread_mutex_unlock_LINKNAME); procedure Unlock (M : in Mutex_Descriptor) is begin Check_NZ (pthread_mutex_unlock (M)); end Unlock; end POSIX.Mutexes;