diff options
Diffstat (limited to 'gcc/ada/s-osinte-vms.ads')
| -rw-r--r-- | gcc/ada/s-osinte-vms.ads | 646 |
1 files changed, 646 insertions, 0 deletions
diff --git a/gcc/ada/s-osinte-vms.ads b/gcc/ada/s-osinte-vms.ads new file mode 100644 index 00000000000..333e02a37b8 --- /dev/null +++ b/gcc/ada/s-osinte-vms.ads @@ -0,0 +1,646 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- S Y S T E M . O S _ I N T E R F A C E -- +-- -- +-- S p e c -- +-- -- +-- 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- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT 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. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. -- +-- Extensive contributions were provided by Ada Core Technologies, Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- 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 +-- 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 Linker_Options ("--for-linker=sys$library:pthread$rtl.exe"); + -- Link in the DEC threads library. + + -- pragma Linker_Options ("--for-linker=/threads_enable"); + -- Enable upcalls and multiple kernel threads. + + subtype int is Interfaces.C.int; + subtype short is Interfaces.C.short; + subtype long is Interfaces.C.long; + subtype unsigned is Interfaces.C.unsigned; + subtype unsigned_short is Interfaces.C.unsigned_short; + subtype unsigned_long is Interfaces.C.unsigned_long; + subtype unsigned_char is Interfaces.C.unsigned_char; + subtype plain_char is Interfaces.C.plain_char; + subtype size_t is Interfaces.C.size_t; + + ----------------------------- + -- Signals (Interrupt IDs) -- + ----------------------------- + + -- Type signal has an arbitrary limit of 31 + + Max_Interrupt : constant := 31; + type Signal is new unsigned range 0 .. Max_Interrupt; + for Signal'Size use unsigned'Size; + + type sigset_t is array (Signal) of Boolean; + pragma Pack (sigset_t); + + -- Interrupt_Number_Type + -- Unsigned long integer denoting the number of an interrupt + + subtype Interrupt_Number_Type is unsigned_long; + + -- OpenVMS system services return values of type Cond_Value_Type. + + subtype Cond_Value_Type is unsigned_long; + subtype Short_Cond_Value_Type is unsigned_short; + + type IO_Status_Block_Type is record + Status : Short_Cond_Value_Type; + Count : unsigned_short; + Dev_Info : unsigned_long; + end record; + + type AST_Handler is access procedure (Param : Address); + No_AST_Handler : constant AST_Handler := null; + + CMB_M_READONLY : constant := 16#00000001#; + CMB_M_WRITEONLY : constant := 16#00000002#; + AGN_M_READONLY : constant := 16#00000001#; + AGN_M_WRITEONLY : constant := 16#00000002#; + + IO_WRITEVBLK : constant := 48; -- WRITE VIRTUAL BLOCK + IO_READVBLK : constant := 49; -- READ VIRTUAL BLOCK + + ---------------- + -- Sys_Assign -- + ---------------- + -- + -- Assign I/O Channel + -- + -- Status = returned status + -- Devnam = address of device name or logical name string + -- descriptor + -- Chan = address of word to receive channel number assigned + -- Acmode = access mode associated with channel + -- Mbxnam = address of mailbox logical name string descriptor, if + -- mailbox associated with device + -- Flags = optional channel flags longword for specifying options + -- for the $ASSIGN operation + -- + + procedure Sys_Assign + (Status : out Cond_Value_Type; + Devnam : in String; + Chan : out unsigned_short; + Acmode : in unsigned_short := 0; + Mbxnam : in String := String'Null_Parameter; + Flags : in unsigned_long := 0); + pragma Interface (External, Sys_Assign); + pragma Import_Valued_Procedure + (Sys_Assign, "SYS$ASSIGN", + (Cond_Value_Type, String, unsigned_short, + unsigned_short, String, unsigned_long), + (Value, Descriptor (s), Reference, + Value, Descriptor (s), Value), + Flags); + + ---------------- + -- Sys_Cantim -- + ---------------- + -- + -- Cancel Timer + -- + -- Status = returned status + -- Reqidt = ID of timer to be cancelled + -- Acmode = Access mode + -- + procedure Sys_Cantim + (Status : out Cond_Value_Type; + Reqidt : in Address; + Acmode : in unsigned); + pragma Interface (External, Sys_Cantim); + pragma Import_Valued_Procedure + (Sys_Cantim, "SYS$CANTIM", + (Cond_Value_Type, Address, unsigned), + (Value, Value, Value)); + + ---------------- + -- Sys_Crembx -- + ---------------- + -- + -- Create mailbox + -- + -- Status = returned status + -- Prmflg = permanent flag + -- Chan = channel + -- Maxmsg = maximum message + -- Bufquo = buufer quote + -- Promsk = protection mast + -- Acmode = access mode + -- Lognam = logical name + -- Flags = flags + -- + procedure Sys_Crembx + (Status : out Cond_Value_Type; + Prmflg : in Boolean; + Chan : out unsigned_short; + Maxmsg : in unsigned_long := 0; + Bufquo : in unsigned_long := 0; + Promsk : in unsigned_short := 0; + Acmode : in unsigned_short := 0; + Lognam : in String; + Flags : in unsigned_long := 0); + pragma Interface (External, Sys_Crembx); + pragma Import_Valued_Procedure + (Sys_Crembx, "SYS$CREMBX", + (Cond_Value_Type, Boolean, unsigned_short, + unsigned_long, unsigned_long, unsigned_short, + unsigned_short, String, unsigned_long), + (Value, Value, Reference, + Value, Value, Value, + Value, Descriptor (s), Value)); + + ------------- + -- Sys_QIO -- + ------------- + -- + -- Queue I/O + -- + -- Status = Returned status of call + -- EFN = event flag to be set when I/O completes + -- Chan = channel + -- Func = function + -- Iosb = I/O status block + -- Astadr = system trap to be generated when I/O completes + -- Astprm = AST parameter + -- P1-6 = optional parameters + + procedure Sys_QIO + (Status : out Cond_Value_Type; + EFN : in unsigned_long := 0; + Chan : in unsigned_short; + Func : in unsigned_long := 0; + Iosb : out IO_Status_Block_Type; + Astadr : in AST_Handler := No_AST_Handler; + Astprm : in Address := Null_Address; + P1 : in unsigned_long := 0; + P2 : in unsigned_long := 0; + P3 : in unsigned_long := 0; + P4 : in unsigned_long := 0; + P5 : in unsigned_long := 0; + P6 : in unsigned_long := 0); + + procedure Sys_QIO + (Status : out Cond_Value_Type; + EFN : in unsigned_long := 0; + Chan : in unsigned_short; + Func : in unsigned_long := 0; + Iosb : in Address := Null_Address; + Astadr : in AST_Handler := No_AST_Handler; + Astprm : in Address := Null_Address; + P1 : in unsigned_long := 0; + P2 : in unsigned_long := 0; + P3 : in unsigned_long := 0; + P4 : in unsigned_long := 0; + P5 : in unsigned_long := 0; + P6 : in unsigned_long := 0); + + pragma Interface (External, Sys_QIO); + pragma Import_Valued_Procedure + (Sys_QIO, "SYS$QIO", + (Cond_Value_Type, unsigned_long, unsigned_short, unsigned_long, + IO_Status_Block_Type, AST_Handler, Address, + unsigned_long, unsigned_long, unsigned_long, + unsigned_long, unsigned_long, unsigned_long), + (Value, Value, Value, Value, + Reference, Value, Value, + Value, Value, Value, + Value, Value, Value)); + + pragma Import_Valued_Procedure + (Sys_QIO, "SYS$QIO", + (Cond_Value_Type, unsigned_long, unsigned_short, unsigned_long, + Address, AST_Handler, Address, + unsigned_long, unsigned_long, unsigned_long, + unsigned_long, unsigned_long, unsigned_long), + (Value, Value, Value, Value, + Value, Value, Value, + Value, Value, Value, + Value, Value, Value)); + + ---------------- + -- Sys_Setimr -- + ---------------- + -- + -- Set Timer + -- + -- Status = Returned status of call + -- EFN = event flag to be set when timer expires + -- Tim = expiration time + -- AST = system trap to be generated when timer expires + -- Redidt = returned ID of timer (e.g. to cancel timer) + -- Flags = flags + -- + procedure Sys_Setimr + (Status : out Cond_Value_Type; + EFN : in unsigned_long; + Tim : in Long_Integer; + AST : in AST_Handler; + Reqidt : in Address; + Flags : in unsigned_long); + pragma Interface (External, Sys_Setimr); + pragma Import_Valued_Procedure + (Sys_Setimr, "SYS$SETIMR", + (Cond_Value_Type, unsigned_long, Long_Integer, + AST_Handler, Address, unsigned_long), + (Value, Value, Reference, + Value, Value, Value)); + + Interrupt_ID_0 : constant := 0; + Interrupt_ID_1 : constant := 1; + Interrupt_ID_2 : constant := 2; + Interrupt_ID_3 : constant := 3; + Interrupt_ID_4 : constant := 4; + Interrupt_ID_5 : constant := 5; + Interrupt_ID_6 : constant := 6; + Interrupt_ID_7 : constant := 7; + Interrupt_ID_8 : constant := 8; + Interrupt_ID_9 : constant := 9; + Interrupt_ID_10 : constant := 10; + Interrupt_ID_11 : constant := 11; + Interrupt_ID_12 : constant := 12; + Interrupt_ID_13 : constant := 13; + Interrupt_ID_14 : constant := 14; + Interrupt_ID_15 : constant := 15; + Interrupt_ID_16 : constant := 16; + Interrupt_ID_17 : constant := 17; + Interrupt_ID_18 : constant := 18; + Interrupt_ID_19 : constant := 19; + Interrupt_ID_20 : constant := 20; + Interrupt_ID_21 : constant := 21; + Interrupt_ID_22 : constant := 22; + Interrupt_ID_23 : constant := 23; + Interrupt_ID_24 : constant := 24; + Interrupt_ID_25 : constant := 25; + Interrupt_ID_26 : constant := 26; + Interrupt_ID_27 : constant := 27; + Interrupt_ID_28 : constant := 28; + Interrupt_ID_29 : constant := 29; + Interrupt_ID_30 : constant := 30; + Interrupt_ID_31 : constant := 31; + + ----------- + -- Errno -- + ----------- + + function errno return int; + pragma Import (C, errno, "__get_errno"); + + EINTR : constant := 4; -- Interrupted system call + EAGAIN : constant := 11; -- No more processes + ENOMEM : constant := 12; -- Not enough core + + ------------------------- + -- Priority Scheduling -- + ------------------------- + + SCHED_FIFO : constant := 1; + SCHED_RR : constant := 2; + SCHED_OTHER : constant := 3; + SCHED_BG : constant := 4; + SCHED_LFI : constant := 5; + SCHED_LRR : constant := 6; + + ------------- + -- Process -- + ------------- + + type pid_t is private; + + function kill (pid : pid_t; sig : Signal) return int; + pragma Import (C, kill); + + function getpid return pid_t; + pragma Import (C, getpid); + + ------------- + -- Threads -- + ------------- + + 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; + + type pthread_mutex_t is limited private; + type pthread_cond_t is limited private; + type pthread_attr_t is limited private; + type pthread_mutexattr_t is limited private; + type pthread_condattr_t is limited private; + type pthread_key_t is private; + + PTHREAD_CREATE_JOINABLE : constant := 0; + PTHREAD_CREATE_DETACHED : constant := 1; + + PTHREAD_CANCEL_DISABLE : constant := 0; + PTHREAD_CANCEL_ENABLE : constant := 1; + + PTHREAD_CANCEL_DEFERRED : constant := 0; + PTHREAD_CANCEL_ASYNCHRONOUS : constant := 1; + + -- Don't use ERRORCHECK mutexes, they don't work when a thread is not + -- the owner. AST's, at least, unlock others threads mutexes. Even + -- if the error is ignored, they don't work. + PTHREAD_MUTEX_NORMAL_NP : constant := 0; + PTHREAD_MUTEX_RECURSIVE_NP : constant := 1; + PTHREAD_MUTEX_ERRORCHECK_NP : constant := 2; + + PTHREAD_INHERIT_SCHED : constant := 0; + PTHREAD_EXPLICIT_SCHED : constant := 1; + + function pthread_cancel (thread : pthread_t) return int; + pragma Import (C, pthread_cancel, "PTHREAD_CANCEL"); + + procedure pthread_testcancel; + pragma Import (C, pthread_testcancel, "PTHREAD_TESTCANCEL"); + + function pthread_setcancelstate + (newstate : int; oldstate : access int) return int; + pragma Import (C, pthread_setcancelstate, "PTHREAD_SETCANCELSTATE"); + + function pthread_setcanceltype + (newtype : int; oldtype : access int) return int; + pragma Import (C, pthread_setcanceltype, "PTHREAD_SETCANCELTYPE"); + + --------------------------- + -- POSIX.1c Section 3 -- + --------------------------- + + function pthread_lock_global_np return int; + pragma Import (C, pthread_lock_global_np, "PTHREAD_LOCK_GLOBAL_NP"); + + function pthread_unlock_global_np return int; + pragma Import (C, pthread_unlock_global_np, "PTHREAD_UNLOCK_GLOBAL_NP"); + + ---------------------------- + -- POSIX.1c Section 11 -- + ---------------------------- + + function pthread_mutexattr_init + (attr : access pthread_mutexattr_t) return int; + pragma Import (C, pthread_mutexattr_init, "PTHREAD_MUTEXATTR_INIT"); + + function pthread_mutexattr_destroy + (attr : access pthread_mutexattr_t) return int; + pragma Import (C, pthread_mutexattr_destroy, "PTHREAD_MUTEXATTR_DESTROY"); + + function pthread_mutexattr_settype_np + (attr : access pthread_mutexattr_t; + mutextype : int) return int; + pragma Import (C, pthread_mutexattr_settype_np, + "PTHREAD_MUTEXATTR_SETTYPE_NP"); + + function pthread_mutex_init + (mutex : access pthread_mutex_t; + attr : access pthread_mutexattr_t) return int; + pragma Import (C, pthread_mutex_init, "PTHREAD_MUTEX_INIT"); + + function pthread_mutex_destroy (mutex : access pthread_mutex_t) return int; + pragma Import (C, pthread_mutex_destroy, "PTHREAD_MUTEX_DESTROY"); + + function pthread_mutex_lock (mutex : access pthread_mutex_t) return int; + pragma Import (C, pthread_mutex_lock, "PTHREAD_MUTEX_LOCK"); + + function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int; + pragma Import (C, pthread_mutex_unlock, "PTHREAD_MUTEX_UNLOCK"); + + function pthread_condattr_init + (attr : access pthread_condattr_t) return int; + pragma Import (C, pthread_condattr_init, "PTHREAD_CONDATTR_INIT"); + + function pthread_condattr_destroy + (attr : access pthread_condattr_t) return int; + pragma Import (C, pthread_condattr_destroy, "PTHREAD_CONDATTR_DESTROY"); + + function pthread_cond_init + (cond : access pthread_cond_t; + attr : access pthread_condattr_t) return int; + pragma Import (C, pthread_cond_init, "PTHREAD_COND_INIT"); + + function pthread_cond_destroy (cond : access pthread_cond_t) return int; + pragma Import (C, pthread_cond_destroy, "PTHREAD_COND_DESTROY"); + + function pthread_cond_signal (cond : access pthread_cond_t) return int; + pragma Import (C, pthread_cond_signal, "PTHREAD_COND_SIGNAL"); + + function pthread_cond_signal_int_np + (cond : access pthread_cond_t) return int; + pragma Import (C, pthread_cond_signal_int_np, + "PTHREAD_COND_SIGNAL_INT_NP"); + + function pthread_cond_wait + (cond : access pthread_cond_t; + mutex : access pthread_mutex_t) return int; + pragma Import (C, pthread_cond_wait, "PTHREAD_COND_WAIT"); + + -------------------------- + -- POSIX.1c Section 13 -- + -------------------------- + + function pthread_mutexattr_setprotocol + (attr : access pthread_mutexattr_t; protocol : int) return int; + pragma Import (C, pthread_mutexattr_setprotocol, + "PTHREAD_MUTEXATTR_SETPROTOCOL"); + + type struct_sched_param is record + sched_priority : int; -- scheduling priority + end record; + for struct_sched_param'Size use 8*4; + pragma Convention (C, struct_sched_param); + + function pthread_setschedparam + (thread : pthread_t; + policy : int; + param : access struct_sched_param) return int; + pragma Import (C, pthread_setschedparam, "PTHREAD_SETSCHEDPARAM"); + + function pthread_attr_setscope + (attr : access pthread_attr_t; + contentionscope : int) return int; + pragma Import (C, pthread_attr_setscope, "PTHREAD_ATTR_SETSCOPE"); + + function pthread_attr_setinheritsched + (attr : access pthread_attr_t; + inheritsched : int) return int; + pragma Import (C, pthread_attr_setinheritsched, + "PTHREAD_ATTR_SETINHERITSCHED"); + + function pthread_attr_setschedpolicy + (attr : access pthread_attr_t; policy : int) return int; + pragma Import (C, pthread_attr_setschedpolicy, + "PTHREAD_ATTR_SETSCHEDPOLICY"); + + function pthread_attr_setschedparam + (attr : access pthread_attr_t; + sched_param : int) return int; + pragma Import (C, pthread_attr_setschedparam, "PTHREAD_ATTR_SETSCHEDPARAM"); + + function sched_yield return int; + + ----------------------------- + -- P1003.1c - Section 16 -- + ----------------------------- + + function pthread_attr_init (attributes : access pthread_attr_t) return int; + pragma Import (C, pthread_attr_init, "PTHREAD_ATTR_INIT"); + + function pthread_attr_destroy + (attributes : access pthread_attr_t) return int; + pragma Import (C, pthread_attr_destroy, "PTHREAD_ATTR_DESTROY"); + + function pthread_attr_setdetachstate + (attr : access pthread_attr_t; + detachstate : int) return int; + pragma Import (C, pthread_attr_setdetachstate, + "PTHREAD_ATTR_SETDETACHSTATE"); + + function pthread_attr_setstacksize + (attr : access pthread_attr_t; + stacksize : size_t) return int; + pragma Import (C, pthread_attr_setstacksize, "PTHREAD_ATTR_SETSTACKSIZE"); + + function pthread_create + (thread : access pthread_t; + attributes : access pthread_attr_t; + start_routine : Thread_Body; + arg : System.Address) return int; + pragma Import (C, pthread_create, "PTHREAD_CREATE"); + + procedure pthread_exit (status : System.Address); + pragma Import (C, pthread_exit, "PTHREAD_EXIT"); + + function pthread_self return pthread_t; + + -------------------------- + -- POSIX.1c Section 17 -- + -------------------------- + + function pthread_setspecific + (key : pthread_key_t; + value : System.Address) return int; + pragma Import (C, pthread_setspecific, "PTHREAD_SETSPECIFIC"); + + function pthread_getspecific (key : pthread_key_t) return System.Address; + pragma Import (C, pthread_getspecific, "PTHREAD_GETSPECIFIC"); + + type destructor_pointer is access procedure (arg : System.Address); + + function pthread_key_create + (key : access pthread_key_t; + destructor : destructor_pointer) return int; + pragma Import (C, pthread_key_create, "PTHREAD_KEY_CREATE"); + +private + + type pid_t is new int; + + type pthreadLongAddr_p is mod 2 ** Long_Integer'Size; + + type pthreadLongAddr_t is mod 2 ** Long_Integer'Size; + type pthreadLongAddr_t_ptr is mod 2 ** Long_Integer'Size; + + type pthreadLongString_t is mod 2 ** Long_Integer'Size; + + type pthreadLongUint_t is mod 2 ** Long_Integer'Size; + type pthreadLongUint_array is array (Natural range <>) + of pthreadLongUint_t; + + type pthread_t is mod 2 ** Long_Integer'Size; + + type pthread_cond_t is record + state : unsigned; + valid : unsigned; + name : pthreadLongString_t; + arg : unsigned; + sequence : unsigned; + block : pthreadLongAddr_t_ptr; + end record; + for pthread_cond_t'Size use 8*32; + pragma Convention (C, pthread_cond_t); + + type pthread_attr_t is record + valid : long; + name : pthreadLongString_t; + arg : pthreadLongUint_t; + reserved : pthreadLongUint_array (0 .. 18); + end record; + for pthread_attr_t'Size use 8*176; + pragma Convention (C, pthread_attr_t); + + type pthread_mutex_t is record + lock : unsigned; + valid : unsigned; + name : pthreadLongString_t; + arg : unsigned; + sequence : unsigned; + block : pthreadLongAddr_p; + owner : unsigned; + depth : unsigned; + end record; + for pthread_mutex_t'Size use 8*40; + pragma Convention (C, pthread_mutex_t); + + type pthread_mutexattr_t is record + valid : long; + reserved : pthreadLongUint_array (0 .. 14); + end record; + for pthread_mutexattr_t'Size use 8*128; + pragma Convention (C, pthread_mutexattr_t); + + type pthread_condattr_t is record + valid : long; + reserved : pthreadLongUint_array (0 .. 12); + end record; + for pthread_condattr_t'Size use 8*112; + pragma Convention (C, pthread_condattr_t); + + type pthread_key_t is new unsigned; + + pragma Inline (pthread_self); + +end System.OS_Interface; |