1 ------------------------------------------------------------------------------
3 -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M . O S _ I N T E R F A C E --
9 -- Copyright (C) 1991-2002 Free Software Foundation, Inc. --
11 -- GNARL is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNARL; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNARL was developed by the GNARL team at Florida State University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 -- This is a OpenVMS/Alpha version of this package.
36 -- This package encapsulates all direct interfaces to OS services
37 -- that are needed by children of System.
39 -- PLEASE DO NOT add any with-clauses to this package
40 -- or remove the pragma Elaborate_Body.
41 -- It is designed to be a bottom-level (leaf) package.
44 package System
.OS_Interface
is
47 pragma Linker_Options
("--for-linker=sys$library:pthread$rtl.exe");
48 -- Link in the DEC threads library.
50 -- pragma Linker_Options ("--for-linker=/threads_enable");
51 -- Enable upcalls and multiple kernel threads.
53 subtype int
is Interfaces
.C
.int
;
54 subtype short
is Interfaces
.C
.short
;
55 subtype long
is Interfaces
.C
.long
;
56 subtype unsigned
is Interfaces
.C
.unsigned
;
57 subtype unsigned_short
is Interfaces
.C
.unsigned_short
;
58 subtype unsigned_long
is Interfaces
.C
.unsigned_long
;
59 subtype unsigned_char
is Interfaces
.C
.unsigned_char
;
60 subtype plain_char
is Interfaces
.C
.plain_char
;
61 subtype size_t
is Interfaces
.C
.size_t
;
63 -----------------------------
64 -- Signals (Interrupt IDs) --
65 -----------------------------
67 -- Type signal has an arbitrary limit of 31
69 Max_Interrupt
: constant := 31;
70 type Signal
is new unsigned
range 0 .. Max_Interrupt
;
71 for Signal
'Size use unsigned
'Size;
73 type sigset_t
is array (Signal
) of Boolean;
74 pragma Pack
(sigset_t
);
76 -- Interrupt_Number_Type
77 -- Unsigned long integer denoting the number of an interrupt
79 subtype Interrupt_Number_Type
is unsigned_long
;
81 -- OpenVMS system services return values of type Cond_Value_Type.
83 subtype Cond_Value_Type
is unsigned_long
;
84 subtype Short_Cond_Value_Type
is unsigned_short
;
86 type IO_Status_Block_Type
is record
87 Status
: Short_Cond_Value_Type
;
88 Count
: unsigned_short
;
89 Dev_Info
: unsigned_long
;
92 type AST_Handler
is access procedure (Param
: Address
);
93 No_AST_Handler
: constant AST_Handler
:= null;
95 CMB_M_READONLY
: constant := 16#
00000001#
;
96 CMB_M_WRITEONLY
: constant := 16#
00000002#
;
97 AGN_M_READONLY
: constant := 16#
00000001#
;
98 AGN_M_WRITEONLY
: constant := 16#
00000002#
;
100 IO_WRITEVBLK
: constant := 48; -- WRITE VIRTUAL BLOCK
101 IO_READVBLK
: constant := 49; -- READ VIRTUAL BLOCK
107 -- Assign I/O Channel
109 -- Status = returned status
110 -- Devnam = address of device name or logical name string
112 -- Chan = address of word to receive channel number assigned
113 -- Acmode = access mode associated with channel
114 -- Mbxnam = address of mailbox logical name string descriptor, if
115 -- mailbox associated with device
116 -- Flags = optional channel flags longword for specifying options
117 -- for the $ASSIGN operation
121 (Status
: out Cond_Value_Type
;
123 Chan
: out unsigned_short
;
124 Acmode
: in unsigned_short
:= 0;
125 Mbxnam
: in String := String'Null_Parameter;
126 Flags
: in unsigned_long
:= 0);
127 pragma Interface
(External
, Sys_Assign
);
128 pragma Import_Valued_Procedure
129 (Sys_Assign
, "SYS$ASSIGN",
130 (Cond_Value_Type
, String, unsigned_short
,
131 unsigned_short
, String, unsigned_long
),
132 (Value
, Descriptor
(s
), Reference
,
133 Value
, Descriptor
(s
), Value
),
142 -- Status = returned status
143 -- Reqidt = ID of timer to be cancelled
144 -- Acmode = Access mode
147 (Status
: out Cond_Value_Type
;
149 Acmode
: in unsigned
);
150 pragma Interface
(External
, Sys_Cantim
);
151 pragma Import_Valued_Procedure
152 (Sys_Cantim
, "SYS$CANTIM",
153 (Cond_Value_Type
, Address
, unsigned
),
154 (Value
, Value
, Value
));
162 -- Status = returned status
163 -- Prmflg = permanent flag
165 -- Maxmsg = maximum message
166 -- Bufquo = buufer quote
167 -- Promsk = protection mast
168 -- Acmode = access mode
169 -- Lognam = logical name
173 (Status
: out Cond_Value_Type
;
175 Chan
: out unsigned_short
;
176 Maxmsg
: in unsigned_long
:= 0;
177 Bufquo
: in unsigned_long
:= 0;
178 Promsk
: in unsigned_short
:= 0;
179 Acmode
: in unsigned_short
:= 0;
181 Flags
: in unsigned_long
:= 0);
182 pragma Interface
(External
, Sys_Crembx
);
183 pragma Import_Valued_Procedure
184 (Sys_Crembx
, "SYS$CREMBX",
185 (Cond_Value_Type
, Boolean, unsigned_short
,
186 unsigned_long
, unsigned_long
, unsigned_short
,
187 unsigned_short
, String, unsigned_long
),
188 (Value
, Value
, Reference
,
190 Value
, Descriptor
(s
), Value
));
198 -- Status = Returned status of call
199 -- EFN = event flag to be set when I/O completes
202 -- Iosb = I/O status block
203 -- Astadr = system trap to be generated when I/O completes
204 -- Astprm = AST parameter
205 -- P1-6 = optional parameters
208 (Status
: out Cond_Value_Type
;
209 EFN
: in unsigned_long
:= 0;
210 Chan
: in unsigned_short
;
211 Func
: in unsigned_long
:= 0;
212 Iosb
: out IO_Status_Block_Type
;
213 Astadr
: in AST_Handler
:= No_AST_Handler
;
214 Astprm
: in Address
:= Null_Address
;
215 P1
: in unsigned_long
:= 0;
216 P2
: in unsigned_long
:= 0;
217 P3
: in unsigned_long
:= 0;
218 P4
: in unsigned_long
:= 0;
219 P5
: in unsigned_long
:= 0;
220 P6
: in unsigned_long
:= 0);
223 (Status
: out Cond_Value_Type
;
224 EFN
: in unsigned_long
:= 0;
225 Chan
: in unsigned_short
;
226 Func
: in unsigned_long
:= 0;
227 Iosb
: in Address
:= Null_Address
;
228 Astadr
: in AST_Handler
:= No_AST_Handler
;
229 Astprm
: in Address
:= Null_Address
;
230 P1
: in unsigned_long
:= 0;
231 P2
: in unsigned_long
:= 0;
232 P3
: in unsigned_long
:= 0;
233 P4
: in unsigned_long
:= 0;
234 P5
: in unsigned_long
:= 0;
235 P6
: in unsigned_long
:= 0);
237 pragma Interface
(External
, Sys_QIO
);
238 pragma Import_Valued_Procedure
240 (Cond_Value_Type
, unsigned_long
, unsigned_short
, unsigned_long
,
241 IO_Status_Block_Type
, AST_Handler
, Address
,
242 unsigned_long
, unsigned_long
, unsigned_long
,
243 unsigned_long
, unsigned_long
, unsigned_long
),
244 (Value
, Value
, Value
, Value
,
245 Reference
, Value
, Value
,
247 Value
, Value
, Value
));
249 pragma Import_Valued_Procedure
251 (Cond_Value_Type
, unsigned_long
, unsigned_short
, unsigned_long
,
252 Address
, AST_Handler
, Address
,
253 unsigned_long
, unsigned_long
, unsigned_long
,
254 unsigned_long
, unsigned_long
, unsigned_long
),
255 (Value
, Value
, Value
, Value
,
258 Value
, Value
, Value
));
266 -- Status = Returned status of call
267 -- EFN = event flag to be set when timer expires
268 -- Tim = expiration time
269 -- AST = system trap to be generated when timer expires
270 -- Redidt = returned ID of timer (e.g. to cancel timer)
274 (Status
: out Cond_Value_Type
;
275 EFN
: in unsigned_long
;
276 Tim
: in Long_Integer;
277 AST
: in AST_Handler
;
279 Flags
: in unsigned_long
);
280 pragma Interface
(External
, Sys_Setimr
);
281 pragma Import_Valued_Procedure
282 (Sys_Setimr
, "SYS$SETIMR",
283 (Cond_Value_Type
, unsigned_long
, Long_Integer,
284 AST_Handler
, Address
, unsigned_long
),
285 (Value
, Value
, Reference
,
286 Value
, Value
, Value
));
288 Interrupt_ID_0
: constant := 0;
289 Interrupt_ID_1
: constant := 1;
290 Interrupt_ID_2
: constant := 2;
291 Interrupt_ID_3
: constant := 3;
292 Interrupt_ID_4
: constant := 4;
293 Interrupt_ID_5
: constant := 5;
294 Interrupt_ID_6
: constant := 6;
295 Interrupt_ID_7
: constant := 7;
296 Interrupt_ID_8
: constant := 8;
297 Interrupt_ID_9
: constant := 9;
298 Interrupt_ID_10
: constant := 10;
299 Interrupt_ID_11
: constant := 11;
300 Interrupt_ID_12
: constant := 12;
301 Interrupt_ID_13
: constant := 13;
302 Interrupt_ID_14
: constant := 14;
303 Interrupt_ID_15
: constant := 15;
304 Interrupt_ID_16
: constant := 16;
305 Interrupt_ID_17
: constant := 17;
306 Interrupt_ID_18
: constant := 18;
307 Interrupt_ID_19
: constant := 19;
308 Interrupt_ID_20
: constant := 20;
309 Interrupt_ID_21
: constant := 21;
310 Interrupt_ID_22
: constant := 22;
311 Interrupt_ID_23
: constant := 23;
312 Interrupt_ID_24
: constant := 24;
313 Interrupt_ID_25
: constant := 25;
314 Interrupt_ID_26
: constant := 26;
315 Interrupt_ID_27
: constant := 27;
316 Interrupt_ID_28
: constant := 28;
317 Interrupt_ID_29
: constant := 29;
318 Interrupt_ID_30
: constant := 30;
319 Interrupt_ID_31
: constant := 31;
325 function errno
return int
;
326 pragma Import
(C
, errno
, "__get_errno");
328 EINTR
: constant := 4; -- Interrupted system call
329 EAGAIN
: constant := 11; -- No more processes
330 ENOMEM
: constant := 12; -- Not enough core
332 -------------------------
333 -- Priority Scheduling --
334 -------------------------
336 SCHED_FIFO
: constant := 1;
337 SCHED_RR
: constant := 2;
338 SCHED_OTHER
: constant := 3;
339 SCHED_BG
: constant := 4;
340 SCHED_LFI
: constant := 5;
341 SCHED_LRR
: constant := 6;
347 type pid_t
is private;
349 function kill
(pid
: pid_t
; sig
: Signal
) return int
;
350 pragma Import
(C
, kill
);
352 function getpid
return pid_t
;
353 pragma Import
(C
, getpid
);
359 type Thread_Body
is access
360 function (arg
: System
.Address
) return System
.Address
;
361 type pthread_t
is private;
362 subtype Thread_Id
is pthread_t
;
364 type pthread_mutex_t
is limited private;
365 type pthread_cond_t
is limited private;
366 type pthread_attr_t
is limited private;
367 type pthread_mutexattr_t
is limited private;
368 type pthread_condattr_t
is limited private;
369 type pthread_key_t
is private;
371 PTHREAD_CREATE_JOINABLE
: constant := 0;
372 PTHREAD_CREATE_DETACHED
: constant := 1;
374 PTHREAD_CANCEL_DISABLE
: constant := 0;
375 PTHREAD_CANCEL_ENABLE
: constant := 1;
377 PTHREAD_CANCEL_DEFERRED
: constant := 0;
378 PTHREAD_CANCEL_ASYNCHRONOUS
: constant := 1;
380 -- Don't use ERRORCHECK mutexes, they don't work when a thread is not
381 -- the owner. AST's, at least, unlock others threads mutexes. Even
382 -- if the error is ignored, they don't work.
383 PTHREAD_MUTEX_NORMAL_NP
: constant := 0;
384 PTHREAD_MUTEX_RECURSIVE_NP
: constant := 1;
385 PTHREAD_MUTEX_ERRORCHECK_NP
: constant := 2;
387 PTHREAD_INHERIT_SCHED
: constant := 0;
388 PTHREAD_EXPLICIT_SCHED
: constant := 1;
390 function pthread_cancel
(thread
: pthread_t
) return int
;
391 pragma Import
(C
, pthread_cancel
, "PTHREAD_CANCEL");
393 procedure pthread_testcancel
;
394 pragma Import
(C
, pthread_testcancel
, "PTHREAD_TESTCANCEL");
396 function pthread_setcancelstate
397 (newstate
: int
; oldstate
: access int
) return int
;
398 pragma Import
(C
, pthread_setcancelstate
, "PTHREAD_SETCANCELSTATE");
400 function pthread_setcanceltype
401 (newtype
: int
; oldtype
: access int
) return int
;
402 pragma Import
(C
, pthread_setcanceltype
, "PTHREAD_SETCANCELTYPE");
404 ---------------------------
405 -- POSIX.1c Section 3 --
406 ---------------------------
408 function pthread_lock_global_np
return int
;
409 pragma Import
(C
, pthread_lock_global_np
, "PTHREAD_LOCK_GLOBAL_NP");
411 function pthread_unlock_global_np
return int
;
412 pragma Import
(C
, pthread_unlock_global_np
, "PTHREAD_UNLOCK_GLOBAL_NP");
414 ----------------------------
415 -- POSIX.1c Section 11 --
416 ----------------------------
418 function pthread_mutexattr_init
419 (attr
: access pthread_mutexattr_t
) return int
;
420 pragma Import
(C
, pthread_mutexattr_init
, "PTHREAD_MUTEXATTR_INIT");
422 function pthread_mutexattr_destroy
423 (attr
: access pthread_mutexattr_t
) return int
;
424 pragma Import
(C
, pthread_mutexattr_destroy
, "PTHREAD_MUTEXATTR_DESTROY");
426 function pthread_mutexattr_settype_np
427 (attr
: access pthread_mutexattr_t
;
428 mutextype
: int
) return int
;
429 pragma Import
(C
, pthread_mutexattr_settype_np
,
430 "PTHREAD_MUTEXATTR_SETTYPE_NP");
432 function pthread_mutex_init
433 (mutex
: access pthread_mutex_t
;
434 attr
: access pthread_mutexattr_t
) return int
;
435 pragma Import
(C
, pthread_mutex_init
, "PTHREAD_MUTEX_INIT");
437 function pthread_mutex_destroy
(mutex
: access pthread_mutex_t
) return int
;
438 pragma Import
(C
, pthread_mutex_destroy
, "PTHREAD_MUTEX_DESTROY");
440 function pthread_mutex_lock
(mutex
: access pthread_mutex_t
) return int
;
441 pragma Import
(C
, pthread_mutex_lock
, "PTHREAD_MUTEX_LOCK");
443 function pthread_mutex_unlock
(mutex
: access pthread_mutex_t
) return int
;
444 pragma Import
(C
, pthread_mutex_unlock
, "PTHREAD_MUTEX_UNLOCK");
446 function pthread_condattr_init
447 (attr
: access pthread_condattr_t
) return int
;
448 pragma Import
(C
, pthread_condattr_init
, "PTHREAD_CONDATTR_INIT");
450 function pthread_condattr_destroy
451 (attr
: access pthread_condattr_t
) return int
;
452 pragma Import
(C
, pthread_condattr_destroy
, "PTHREAD_CONDATTR_DESTROY");
454 function pthread_cond_init
455 (cond
: access pthread_cond_t
;
456 attr
: access pthread_condattr_t
) return int
;
457 pragma Import
(C
, pthread_cond_init
, "PTHREAD_COND_INIT");
459 function pthread_cond_destroy
(cond
: access pthread_cond_t
) return int
;
460 pragma Import
(C
, pthread_cond_destroy
, "PTHREAD_COND_DESTROY");
462 function pthread_cond_signal
(cond
: access pthread_cond_t
) return int
;
463 pragma Import
(C
, pthread_cond_signal
, "PTHREAD_COND_SIGNAL");
465 function pthread_cond_signal_int_np
466 (cond
: access pthread_cond_t
) return int
;
467 pragma Import
(C
, pthread_cond_signal_int_np
,
468 "PTHREAD_COND_SIGNAL_INT_NP");
470 function pthread_cond_wait
471 (cond
: access pthread_cond_t
;
472 mutex
: access pthread_mutex_t
) return int
;
473 pragma Import
(C
, pthread_cond_wait
, "PTHREAD_COND_WAIT");
475 --------------------------
476 -- POSIX.1c Section 13 --
477 --------------------------
479 function pthread_mutexattr_setprotocol
480 (attr
: access pthread_mutexattr_t
; protocol
: int
) return int
;
481 pragma Import
(C
, pthread_mutexattr_setprotocol
,
482 "PTHREAD_MUTEXATTR_SETPROTOCOL");
484 type struct_sched_param
is record
485 sched_priority
: int
; -- scheduling priority
487 for struct_sched_param
'Size use 8*4;
488 pragma Convention
(C
, struct_sched_param
);
490 function pthread_setschedparam
493 param
: access struct_sched_param
) return int
;
494 pragma Import
(C
, pthread_setschedparam
, "PTHREAD_SETSCHEDPARAM");
496 function pthread_attr_setscope
497 (attr
: access pthread_attr_t
;
498 contentionscope
: int
) return int
;
499 pragma Import
(C
, pthread_attr_setscope
, "PTHREAD_ATTR_SETSCOPE");
501 function pthread_attr_setinheritsched
502 (attr
: access pthread_attr_t
;
503 inheritsched
: int
) return int
;
504 pragma Import
(C
, pthread_attr_setinheritsched
,
505 "PTHREAD_ATTR_SETINHERITSCHED");
507 function pthread_attr_setschedpolicy
508 (attr
: access pthread_attr_t
; policy
: int
) return int
;
509 pragma Import
(C
, pthread_attr_setschedpolicy
,
510 "PTHREAD_ATTR_SETSCHEDPOLICY");
512 function pthread_attr_setschedparam
513 (attr
: access pthread_attr_t
;
514 sched_param
: int
) return int
;
515 pragma Import
(C
, pthread_attr_setschedparam
, "PTHREAD_ATTR_SETSCHEDPARAM");
517 function sched_yield
return int
;
519 -----------------------------
520 -- P1003.1c - Section 16 --
521 -----------------------------
523 function pthread_attr_init
(attributes
: access pthread_attr_t
) return int
;
524 pragma Import
(C
, pthread_attr_init
, "PTHREAD_ATTR_INIT");
526 function pthread_attr_destroy
527 (attributes
: access pthread_attr_t
) return int
;
528 pragma Import
(C
, pthread_attr_destroy
, "PTHREAD_ATTR_DESTROY");
530 function pthread_attr_setdetachstate
531 (attr
: access pthread_attr_t
;
532 detachstate
: int
) return int
;
533 pragma Import
(C
, pthread_attr_setdetachstate
,
534 "PTHREAD_ATTR_SETDETACHSTATE");
536 function pthread_attr_setstacksize
537 (attr
: access pthread_attr_t
;
538 stacksize
: size_t
) return int
;
539 pragma Import
(C
, pthread_attr_setstacksize
, "PTHREAD_ATTR_SETSTACKSIZE");
541 function pthread_create
542 (thread
: access pthread_t
;
543 attributes
: access pthread_attr_t
;
544 start_routine
: Thread_Body
;
545 arg
: System
.Address
) return int
;
546 pragma Import
(C
, pthread_create
, "PTHREAD_CREATE");
548 procedure pthread_exit
(status
: System
.Address
);
549 pragma Import
(C
, pthread_exit
, "PTHREAD_EXIT");
551 function pthread_self
return pthread_t
;
553 --------------------------
554 -- POSIX.1c Section 17 --
555 --------------------------
557 function pthread_setspecific
558 (key
: pthread_key_t
;
559 value
: System
.Address
) return int
;
560 pragma Import
(C
, pthread_setspecific
, "PTHREAD_SETSPECIFIC");
562 function pthread_getspecific
(key
: pthread_key_t
) return System
.Address
;
563 pragma Import
(C
, pthread_getspecific
, "PTHREAD_GETSPECIFIC");
565 type destructor_pointer
is access procedure (arg
: System
.Address
);
567 function pthread_key_create
568 (key
: access pthread_key_t
;
569 destructor
: destructor_pointer
) return int
;
570 pragma Import
(C
, pthread_key_create
, "PTHREAD_KEY_CREATE");
574 type pid_t
is new int
;
576 type pthreadLongAddr_p
is mod 2 ** Long_Integer'Size;
578 type pthreadLongAddr_t
is mod 2 ** Long_Integer'Size;
579 type pthreadLongAddr_t_ptr
is mod 2 ** Long_Integer'Size;
581 type pthreadLongString_t
is mod 2 ** Long_Integer'Size;
583 type pthreadLongUint_t
is mod 2 ** Long_Integer'Size;
584 type pthreadLongUint_array
is array (Natural range <>)
585 of pthreadLongUint_t
;
587 type pthread_t
is mod 2 ** Long_Integer'Size;
589 type pthread_cond_t
is record
592 name
: pthreadLongString_t
;
595 block
: pthreadLongAddr_t_ptr
;
597 for pthread_cond_t
'Size use 8*32;
598 pragma Convention
(C
, pthread_cond_t
);
600 type pthread_attr_t
is record
602 name
: pthreadLongString_t
;
603 arg
: pthreadLongUint_t
;
604 reserved
: pthreadLongUint_array
(0 .. 18);
606 for pthread_attr_t
'Size use 8*176;
607 pragma Convention
(C
, pthread_attr_t
);
609 type pthread_mutex_t
is record
612 name
: pthreadLongString_t
;
615 block
: pthreadLongAddr_p
;
619 for pthread_mutex_t
'Size use 8*40;
620 pragma Convention
(C
, pthread_mutex_t
);
622 type pthread_mutexattr_t
is record
624 reserved
: pthreadLongUint_array
(0 .. 14);
626 for pthread_mutexattr_t
'Size use 8*128;
627 pragma Convention
(C
, pthread_mutexattr_t
);
629 type pthread_condattr_t
is record
631 reserved
: pthreadLongUint_array
(0 .. 12);
633 for pthread_condattr_t
'Size use 8*112;
634 pragma Convention
(C
, pthread_condattr_t
);
636 type pthread_key_t
is new unsigned
;
638 pragma Inline
(pthread_self
);
640 end System
.OS_Interface
;