Daily bump.
[official-gcc.git] / gcc / ada / 5vosinte.ads
blobdbbc6d7d2ad9478219dbbdcdfc1416cbff68a7a3
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
4 -- --
5 -- S Y S T E M . O S _ I N T E R F A C E --
6 -- --
7 -- S p e c --
8 -- --
9 -- $Revision: 1.1 $
10 -- --
11 -- Copyright (C) 1991-2001 Free Software Foundation, Inc. --
12 -- --
13 -- GNARL is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNARL; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
23 -- --
24 -- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
26 -- this unit does not by itself cause the resulting executable to be --
27 -- covered by the GNU General Public License. This exception does not --
28 -- however invalidate any other reasons why the executable file might be --
29 -- covered by the GNU Public License. --
30 -- --
31 -- GNARL was developed by the GNARL team at Florida State University. --
32 -- Extensive contributions were provided by Ada Core Technologies Inc. --
33 -- --
34 ------------------------------------------------------------------------------
36 -- This is a OpenVMS/Alpha version of this package.
38 -- This package encapsulates all direct interfaces to OS services
39 -- that are needed by children of System.
41 -- PLEASE DO NOT add any with-clauses to this package
42 -- or remove the pragma Elaborate_Body.
43 -- It is designed to be a bottom-level (leaf) package.
45 with Interfaces.C;
46 package System.OS_Interface is
47 pragma Preelaborate;
49 pragma Linker_Options ("--for-linker=sys$library:pthread$rtl.exe");
50 -- Link in the DEC threads library.
52 -- pragma Linker_Options ("--for-linker=/threads_enable");
53 -- Enable upcalls and multiple kernel threads.
55 subtype int is Interfaces.C.int;
56 subtype short is Interfaces.C.short;
57 subtype long is Interfaces.C.long;
58 subtype unsigned is Interfaces.C.unsigned;
59 subtype unsigned_short is Interfaces.C.unsigned_short;
60 subtype unsigned_long is Interfaces.C.unsigned_long;
61 subtype unsigned_char is Interfaces.C.unsigned_char;
62 subtype plain_char is Interfaces.C.plain_char;
63 subtype size_t is Interfaces.C.size_t;
65 -----------------------------
66 -- Signals (Interrupt IDs) --
67 -----------------------------
69 -- Type signal has an arbitrary limit of 31
71 Max_Interrupt : constant := 31;
72 type Signal is new unsigned range 0 .. Max_Interrupt;
73 for Signal'Size use unsigned'Size;
75 type sigset_t is array (Signal) of Boolean;
76 pragma Pack (sigset_t);
78 -- Interrupt_Number_Type
79 -- Unsigned long integer denoting the number of an interrupt
81 subtype Interrupt_Number_Type is unsigned_long;
83 -- OpenVMS system services return values of type Cond_Value_Type.
85 subtype Cond_Value_Type is unsigned_long;
86 subtype Short_Cond_Value_Type is unsigned_short;
88 type IO_Status_Block_Type is record
89 Status : Short_Cond_Value_Type;
90 Count : unsigned_short;
91 Dev_Info : unsigned_long;
92 end record;
94 type AST_Handler is access procedure (Param : Address);
95 No_AST_Handler : constant AST_Handler := null;
97 CMB_M_READONLY : constant := 16#00000001#;
98 CMB_M_WRITEONLY : constant := 16#00000002#;
99 AGN_M_READONLY : constant := 16#00000001#;
100 AGN_M_WRITEONLY : constant := 16#00000002#;
102 IO_WRITEVBLK : constant := 48; -- WRITE VIRTUAL BLOCK
103 IO_READVBLK : constant := 49; -- READ VIRTUAL BLOCK
105 ----------------
106 -- Sys_Assign --
107 ----------------
109 -- Assign I/O Channel
111 -- Status = returned status
112 -- Devnam = address of device name or logical name string
113 -- descriptor
114 -- Chan = address of word to receive channel number assigned
115 -- Acmode = access mode associated with channel
116 -- Mbxnam = address of mailbox logical name string descriptor, if
117 -- mailbox associated with device
118 -- Flags = optional channel flags longword for specifying options
119 -- for the $ASSIGN operation
122 procedure Sys_Assign
123 (Status : out Cond_Value_Type;
124 Devnam : in String;
125 Chan : out unsigned_short;
126 Acmode : in unsigned_short := 0;
127 Mbxnam : in String := String'Null_Parameter;
128 Flags : in unsigned_long := 0);
129 pragma Interface (External, Sys_Assign);
130 pragma Import_Valued_Procedure
131 (Sys_Assign, "SYS$ASSIGN",
132 (Cond_Value_Type, String, unsigned_short,
133 unsigned_short, String, unsigned_long),
134 (Value, Descriptor (s), Reference,
135 Value, Descriptor (s), Value),
136 Flags);
138 ----------------
139 -- Sys_Cantim --
140 ----------------
142 -- Cancel Timer
144 -- Status = returned status
145 -- Reqidt = ID of timer to be cancelled
146 -- Acmode = Access mode
148 procedure Sys_Cantim
149 (Status : out Cond_Value_Type;
150 Reqidt : in Address;
151 Acmode : in unsigned);
152 pragma Interface (External, Sys_Cantim);
153 pragma Import_Valued_Procedure
154 (Sys_Cantim, "SYS$CANTIM",
155 (Cond_Value_Type, Address, unsigned),
156 (Value, Value, Value));
158 ----------------
159 -- Sys_Crembx --
160 ----------------
162 -- Create mailbox
164 -- Status = returned status
165 -- Prmflg = permanent flag
166 -- Chan = channel
167 -- Maxmsg = maximum message
168 -- Bufquo = buufer quote
169 -- Promsk = protection mast
170 -- Acmode = access mode
171 -- Lognam = logical name
172 -- Flags = flags
174 procedure Sys_Crembx
175 (Status : out Cond_Value_Type;
176 Prmflg : in Boolean;
177 Chan : out unsigned_short;
178 Maxmsg : in unsigned_long := 0;
179 Bufquo : in unsigned_long := 0;
180 Promsk : in unsigned_short := 0;
181 Acmode : in unsigned_short := 0;
182 Lognam : in String;
183 Flags : in unsigned_long := 0);
184 pragma Interface (External, Sys_Crembx);
185 pragma Import_Valued_Procedure
186 (Sys_Crembx, "SYS$CREMBX",
187 (Cond_Value_Type, Boolean, unsigned_short,
188 unsigned_long, unsigned_long, unsigned_short,
189 unsigned_short, String, unsigned_long),
190 (Value, Value, Reference,
191 Value, Value, Value,
192 Value, Descriptor (s), Value));
194 -------------
195 -- Sys_QIO --
196 -------------
198 -- Queue I/O
200 -- Status = Returned status of call
201 -- EFN = event flag to be set when I/O completes
202 -- Chan = channel
203 -- Func = function
204 -- Iosb = I/O status block
205 -- Astadr = system trap to be generated when I/O completes
206 -- Astprm = AST parameter
207 -- P1-6 = optional parameters
209 procedure Sys_QIO
210 (Status : out Cond_Value_Type;
211 EFN : in unsigned_long := 0;
212 Chan : in unsigned_short;
213 Func : in unsigned_long := 0;
214 Iosb : out IO_Status_Block_Type;
215 Astadr : in AST_Handler := No_AST_Handler;
216 Astprm : in Address := Null_Address;
217 P1 : in unsigned_long := 0;
218 P2 : in unsigned_long := 0;
219 P3 : in unsigned_long := 0;
220 P4 : in unsigned_long := 0;
221 P5 : in unsigned_long := 0;
222 P6 : in unsigned_long := 0);
224 procedure Sys_QIO
225 (Status : out Cond_Value_Type;
226 EFN : in unsigned_long := 0;
227 Chan : in unsigned_short;
228 Func : in unsigned_long := 0;
229 Iosb : in Address := Null_Address;
230 Astadr : in AST_Handler := No_AST_Handler;
231 Astprm : in Address := Null_Address;
232 P1 : in unsigned_long := 0;
233 P2 : in unsigned_long := 0;
234 P3 : in unsigned_long := 0;
235 P4 : in unsigned_long := 0;
236 P5 : in unsigned_long := 0;
237 P6 : in unsigned_long := 0);
239 pragma Interface (External, Sys_QIO);
240 pragma Import_Valued_Procedure
241 (Sys_QIO, "SYS$QIO",
242 (Cond_Value_Type, unsigned_long, unsigned_short, unsigned_long,
243 IO_Status_Block_Type, AST_Handler, Address,
244 unsigned_long, unsigned_long, unsigned_long,
245 unsigned_long, unsigned_long, unsigned_long),
246 (Value, Value, Value, Value,
247 Reference, Value, Value,
248 Value, Value, Value,
249 Value, Value, Value));
251 pragma Import_Valued_Procedure
252 (Sys_QIO, "SYS$QIO",
253 (Cond_Value_Type, unsigned_long, unsigned_short, unsigned_long,
254 Address, AST_Handler, Address,
255 unsigned_long, unsigned_long, unsigned_long,
256 unsigned_long, unsigned_long, unsigned_long),
257 (Value, Value, Value, Value,
258 Value, Value, Value,
259 Value, Value, Value,
260 Value, Value, Value));
262 ----------------
263 -- Sys_Setimr --
264 ----------------
266 -- Set Timer
268 -- Status = Returned status of call
269 -- EFN = event flag to be set when timer expires
270 -- Tim = expiration time
271 -- AST = system trap to be generated when timer expires
272 -- Redidt = returned ID of timer (e.g. to cancel timer)
273 -- Flags = flags
275 procedure Sys_Setimr
276 (Status : out Cond_Value_Type;
277 EFN : in unsigned_long;
278 Tim : in Long_Integer;
279 AST : in AST_Handler;
280 Reqidt : in Address;
281 Flags : in unsigned_long);
282 pragma Interface (External, Sys_Setimr);
283 pragma Import_Valued_Procedure
284 (Sys_Setimr, "SYS$SETIMR",
285 (Cond_Value_Type, unsigned_long, Long_Integer,
286 AST_Handler, Address, unsigned_long),
287 (Value, Value, Reference,
288 Value, Value, Value));
290 Interrupt_ID_0 : constant := 0;
291 Interrupt_ID_1 : constant := 1;
292 Interrupt_ID_2 : constant := 2;
293 Interrupt_ID_3 : constant := 3;
294 Interrupt_ID_4 : constant := 4;
295 Interrupt_ID_5 : constant := 5;
296 Interrupt_ID_6 : constant := 6;
297 Interrupt_ID_7 : constant := 7;
298 Interrupt_ID_8 : constant := 8;
299 Interrupt_ID_9 : constant := 9;
300 Interrupt_ID_10 : constant := 10;
301 Interrupt_ID_11 : constant := 11;
302 Interrupt_ID_12 : constant := 12;
303 Interrupt_ID_13 : constant := 13;
304 Interrupt_ID_14 : constant := 14;
305 Interrupt_ID_15 : constant := 15;
306 Interrupt_ID_16 : constant := 16;
307 Interrupt_ID_17 : constant := 17;
308 Interrupt_ID_18 : constant := 18;
309 Interrupt_ID_19 : constant := 19;
310 Interrupt_ID_20 : constant := 20;
311 Interrupt_ID_21 : constant := 21;
312 Interrupt_ID_22 : constant := 22;
313 Interrupt_ID_23 : constant := 23;
314 Interrupt_ID_24 : constant := 24;
315 Interrupt_ID_25 : constant := 25;
316 Interrupt_ID_26 : constant := 26;
317 Interrupt_ID_27 : constant := 27;
318 Interrupt_ID_28 : constant := 28;
319 Interrupt_ID_29 : constant := 29;
320 Interrupt_ID_30 : constant := 30;
321 Interrupt_ID_31 : constant := 31;
323 -----------
324 -- Errno --
325 -----------
327 function errno return int;
328 pragma Import (C, errno, "__get_errno");
330 EINTR : constant := 4; -- Interrupted system call
331 EAGAIN : constant := 11; -- No more processes
332 ENOMEM : constant := 12; -- Not enough core
334 -------------------------
335 -- Priority Scheduling --
336 -------------------------
338 SCHED_FIFO : constant := 1;
339 SCHED_RR : constant := 2;
340 SCHED_OTHER : constant := 3;
341 SCHED_BG : constant := 4;
342 SCHED_LFI : constant := 5;
343 SCHED_LRR : constant := 6;
345 -------------
346 -- Process --
347 -------------
349 type pid_t is private;
351 function kill (pid : pid_t; sig : Signal) return int;
352 pragma Import (C, kill);
354 function getpid return pid_t;
355 pragma Import (C, getpid);
357 -------------
358 -- Threads --
359 -------------
361 type Thread_Body is access
362 function (arg : System.Address) return System.Address;
363 type pthread_t is private;
364 subtype Thread_Id is pthread_t;
366 type pthread_mutex_t is limited private;
367 type pthread_cond_t is limited private;
368 type pthread_attr_t is limited private;
369 type pthread_mutexattr_t is limited private;
370 type pthread_condattr_t is limited private;
371 type pthread_key_t is private;
373 PTHREAD_CREATE_JOINABLE : constant := 0;
374 PTHREAD_CREATE_DETACHED : constant := 1;
376 PTHREAD_CANCEL_DISABLE : constant := 0;
377 PTHREAD_CANCEL_ENABLE : constant := 1;
379 PTHREAD_CANCEL_DEFERRED : constant := 0;
380 PTHREAD_CANCEL_ASYNCHRONOUS : constant := 1;
382 -- Don't use ERRORCHECK mutexes, they don't work when a thread is not
383 -- the owner. AST's, at least, unlock others threads mutexes. Even
384 -- if the error is ignored, they don't work.
385 PTHREAD_MUTEX_NORMAL_NP : constant := 0;
386 PTHREAD_MUTEX_RECURSIVE_NP : constant := 1;
387 PTHREAD_MUTEX_ERRORCHECK_NP : constant := 2;
389 PTHREAD_INHERIT_SCHED : constant := 0;
390 PTHREAD_EXPLICIT_SCHED : constant := 1;
392 function pthread_cancel (thread : pthread_t) return int;
393 pragma Import (C, pthread_cancel, "PTHREAD_CANCEL");
395 procedure pthread_testcancel;
396 pragma Import (C, pthread_testcancel, "PTHREAD_TESTCANCEL");
398 function pthread_setcancelstate
399 (newstate : int; oldstate : access int) return int;
400 pragma Import (C, pthread_setcancelstate, "PTHREAD_SETCANCELSTATE");
402 function pthread_setcanceltype
403 (newtype : int; oldtype : access int) return int;
404 pragma Import (C, pthread_setcanceltype, "PTHREAD_SETCANCELTYPE");
406 ---------------------------
407 -- POSIX.1c Section 3 --
408 ---------------------------
410 function pthread_lock_global_np return int;
411 pragma Import (C, pthread_lock_global_np, "PTHREAD_LOCK_GLOBAL_NP");
413 function pthread_unlock_global_np return int;
414 pragma Import (C, pthread_unlock_global_np, "PTHREAD_UNLOCK_GLOBAL_NP");
416 ----------------------------
417 -- POSIX.1c Section 11 --
418 ----------------------------
420 function pthread_mutexattr_init
421 (attr : access pthread_mutexattr_t) return int;
422 pragma Import (C, pthread_mutexattr_init, "PTHREAD_MUTEXATTR_INIT");
424 function pthread_mutexattr_destroy
425 (attr : access pthread_mutexattr_t) return int;
426 pragma Import (C, pthread_mutexattr_destroy, "PTHREAD_MUTEXATTR_DESTROY");
428 function pthread_mutexattr_settype_np
429 (attr : access pthread_mutexattr_t;
430 mutextype : int) return int;
431 pragma Import (C, pthread_mutexattr_settype_np,
432 "PTHREAD_MUTEXATTR_SETTYPE_NP");
434 function pthread_mutex_init
435 (mutex : access pthread_mutex_t;
436 attr : access pthread_mutexattr_t) return int;
437 pragma Import (C, pthread_mutex_init, "PTHREAD_MUTEX_INIT");
439 function pthread_mutex_destroy (mutex : access pthread_mutex_t) return int;
440 pragma Import (C, pthread_mutex_destroy, "PTHREAD_MUTEX_DESTROY");
442 function pthread_mutex_lock (mutex : access pthread_mutex_t) return int;
443 pragma Import (C, pthread_mutex_lock, "PTHREAD_MUTEX_LOCK");
445 function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int;
446 pragma Import (C, pthread_mutex_unlock, "PTHREAD_MUTEX_UNLOCK");
448 function pthread_condattr_init
449 (attr : access pthread_condattr_t) return int;
450 pragma Import (C, pthread_condattr_init, "PTHREAD_CONDATTR_INIT");
452 function pthread_condattr_destroy
453 (attr : access pthread_condattr_t) return int;
454 pragma Import (C, pthread_condattr_destroy, "PTHREAD_CONDATTR_DESTROY");
456 function pthread_cond_init
457 (cond : access pthread_cond_t;
458 attr : access pthread_condattr_t) return int;
459 pragma Import (C, pthread_cond_init, "PTHREAD_COND_INIT");
461 function pthread_cond_destroy (cond : access pthread_cond_t) return int;
462 pragma Import (C, pthread_cond_destroy, "PTHREAD_COND_DESTROY");
464 function pthread_cond_signal (cond : access pthread_cond_t) return int;
465 pragma Import (C, pthread_cond_signal, "PTHREAD_COND_SIGNAL");
467 function pthread_cond_signal_int_np
468 (cond : access pthread_cond_t) return int;
469 pragma Import (C, pthread_cond_signal_int_np,
470 "PTHREAD_COND_SIGNAL_INT_NP");
472 function pthread_cond_wait
473 (cond : access pthread_cond_t;
474 mutex : access pthread_mutex_t) return int;
475 pragma Import (C, pthread_cond_wait, "PTHREAD_COND_WAIT");
477 --------------------------
478 -- POSIX.1c Section 13 --
479 --------------------------
481 function pthread_mutexattr_setprotocol
482 (attr : access pthread_mutexattr_t; protocol : int) return int;
483 pragma Import (C, pthread_mutexattr_setprotocol,
484 "PTHREAD_MUTEXATTR_SETPROTOCOL");
486 type struct_sched_param is record
487 sched_priority : int; -- scheduling priority
488 end record;
489 for struct_sched_param'Size use 8*4;
490 pragma Convention (C, struct_sched_param);
492 function pthread_setschedparam
493 (thread : pthread_t;
494 policy : int;
495 param : access struct_sched_param) return int;
496 pragma Import (C, pthread_setschedparam, "PTHREAD_SETSCHEDPARAM");
498 function pthread_attr_setscope
499 (attr : access pthread_attr_t;
500 contentionscope : int) return int;
501 pragma Import (C, pthread_attr_setscope, "PTHREAD_ATTR_SETSCOPE");
503 function pthread_attr_setinheritsched
504 (attr : access pthread_attr_t;
505 inheritsched : int) return int;
506 pragma Import (C, pthread_attr_setinheritsched,
507 "PTHREAD_ATTR_SETINHERITSCHED");
509 function pthread_attr_setschedpolicy
510 (attr : access pthread_attr_t; policy : int) return int;
511 pragma Import (C, pthread_attr_setschedpolicy,
512 "PTHREAD_ATTR_SETSCHEDPOLICY");
514 function pthread_attr_setschedparam
515 (attr : access pthread_attr_t;
516 sched_param : int) return int;
517 pragma Import (C, pthread_attr_setschedparam, "PTHREAD_ATTR_SETSCHEDPARAM");
519 function sched_yield return int;
521 -----------------------------
522 -- P1003.1c - Section 16 --
523 -----------------------------
525 function pthread_attr_init (attributes : access pthread_attr_t) return int;
526 pragma Import (C, pthread_attr_init, "PTHREAD_ATTR_INIT");
528 function pthread_attr_destroy
529 (attributes : access pthread_attr_t) return int;
530 pragma Import (C, pthread_attr_destroy, "PTHREAD_ATTR_DESTROY");
532 function pthread_attr_setdetachstate
533 (attr : access pthread_attr_t;
534 detachstate : int) return int;
535 pragma Import (C, pthread_attr_setdetachstate,
536 "PTHREAD_ATTR_SETDETACHSTATE");
538 function pthread_attr_setstacksize
539 (attr : access pthread_attr_t;
540 stacksize : size_t) return int;
541 pragma Import (C, pthread_attr_setstacksize, "PTHREAD_ATTR_SETSTACKSIZE");
543 function pthread_create
544 (thread : access pthread_t;
545 attributes : access pthread_attr_t;
546 start_routine : Thread_Body;
547 arg : System.Address) return int;
548 pragma Import (C, pthread_create, "PTHREAD_CREATE");
550 procedure pthread_exit (status : System.Address);
551 pragma Import (C, pthread_exit, "PTHREAD_EXIT");
553 function pthread_self return pthread_t;
554 pragma Import (C, pthread_self, "PTHREAD_SELF");
556 --------------------------
557 -- POSIX.1c Section 17 --
558 --------------------------
560 function pthread_setspecific
561 (key : pthread_key_t;
562 value : System.Address) return int;
563 pragma Import (C, pthread_setspecific, "PTHREAD_SETSPECIFIC");
565 function pthread_getspecific (key : pthread_key_t) return System.Address;
566 pragma Import (C, pthread_getspecific, "PTHREAD_GETSPECIFIC");
568 type destructor_pointer is access procedure (arg : System.Address);
570 function pthread_key_create
571 (key : access pthread_key_t;
572 destructor : destructor_pointer) return int;
573 pragma Import (C, pthread_key_create, "PTHREAD_KEY_CREATE");
575 private
577 type pid_t is new int;
579 type pthreadLongAddr_p is mod 2 ** Long_Integer'Size;
581 type pthreadLongAddr_t is mod 2 ** Long_Integer'Size;
582 type pthreadLongAddr_t_ptr is mod 2 ** Long_Integer'Size;
584 type pthreadLongString_t is mod 2 ** Long_Integer'Size;
586 type pthreadLongUint_t is mod 2 ** Long_Integer'Size;
587 type pthreadLongUint_array is array (Natural range <>)
588 of pthreadLongUint_t;
590 type pthread_t is mod 2 ** Long_Integer'Size;
592 type pthread_cond_t is record
593 state : unsigned;
594 valid : unsigned;
595 name : pthreadLongString_t;
596 arg : unsigned;
597 sequence : unsigned;
598 block : pthreadLongAddr_t_ptr;
599 end record;
600 for pthread_cond_t'Size use 8*32;
601 pragma Convention (C, pthread_cond_t);
603 type pthread_attr_t is record
604 valid : long;
605 name : pthreadLongString_t;
606 arg : pthreadLongUint_t;
607 reserved : pthreadLongUint_array (0 .. 18);
608 end record;
609 for pthread_attr_t'Size use 8*176;
610 pragma Convention (C, pthread_attr_t);
612 type pthread_mutex_t is record
613 lock : unsigned;
614 valid : unsigned;
615 name : pthreadLongString_t;
616 arg : unsigned;
617 sequence : unsigned;
618 block : pthreadLongAddr_p;
619 owner : unsigned;
620 depth : unsigned;
621 end record;
622 for pthread_mutex_t'Size use 8*40;
623 pragma Convention (C, pthread_mutex_t);
625 type pthread_mutexattr_t is record
626 valid : long;
627 reserved : pthreadLongUint_array (0 .. 14);
628 end record;
629 for pthread_mutexattr_t'Size use 8*128;
630 pragma Convention (C, pthread_mutexattr_t);
632 type pthread_condattr_t is record
633 valid : long;
634 reserved : pthreadLongUint_array (0 .. 12);
635 end record;
636 for pthread_condattr_t'Size use 8*112;
637 pragma Convention (C, pthread_condattr_t);
639 type pthread_key_t is new unsigned;
641 end System.OS_Interface;