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 --
11 -- Copyright (C) 1991-2001 Free Software Foundation, Inc. --
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. --
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. --
31 -- GNARL was developed by the GNARL team at Florida State University. --
32 -- Extensive contributions were provided by Ada Core Technologies Inc. --
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.
46 package System
.OS_Interface
is
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
;
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
109 -- Assign I/O Channel
111 -- Status = returned status
112 -- Devnam = address of device name or logical name string
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
123 (Status
: out Cond_Value_Type
;
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
),
144 -- Status = returned status
145 -- Reqidt = ID of timer to be cancelled
146 -- Acmode = Access mode
149 (Status
: out Cond_Value_Type
;
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
));
164 -- Status = returned status
165 -- Prmflg = permanent flag
167 -- Maxmsg = maximum message
168 -- Bufquo = buufer quote
169 -- Promsk = protection mast
170 -- Acmode = access mode
171 -- Lognam = logical name
175 (Status
: out Cond_Value_Type
;
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;
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
,
192 Value
, Descriptor
(s
), Value
));
200 -- Status = Returned status of call
201 -- EFN = event flag to be set when I/O completes
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
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);
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
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
,
249 Value
, Value
, Value
));
251 pragma Import_Valued_Procedure
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
,
260 Value
, Value
, Value
));
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)
276 (Status
: out Cond_Value_Type
;
277 EFN
: in unsigned_long
;
278 Tim
: in Long_Integer;
279 AST
: in AST_Handler
;
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;
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;
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
);
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
489 for struct_sched_param
'Size use 8*4;
490 pragma Convention
(C
, struct_sched_param
);
492 function pthread_setschedparam
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");
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
595 name
: pthreadLongString_t
;
598 block
: pthreadLongAddr_t_ptr
;
600 for pthread_cond_t
'Size use 8*32;
601 pragma Convention
(C
, pthread_cond_t
);
603 type pthread_attr_t
is record
605 name
: pthreadLongString_t
;
606 arg
: pthreadLongUint_t
;
607 reserved
: pthreadLongUint_array
(0 .. 18);
609 for pthread_attr_t
'Size use 8*176;
610 pragma Convention
(C
, pthread_attr_t
);
612 type pthread_mutex_t
is record
615 name
: pthreadLongString_t
;
618 block
: pthreadLongAddr_p
;
622 for pthread_mutex_t
'Size use 8*40;
623 pragma Convention
(C
, pthread_mutex_t
);
625 type pthread_mutexattr_t
is record
627 reserved
: pthreadLongUint_array
(0 .. 14);
629 for pthread_mutexattr_t
'Size use 8*128;
630 pragma Convention
(C
, pthread_mutexattr_t
);
632 type pthread_condattr_t
is record
634 reserved
: pthreadLongUint_array
(0 .. 12);
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
;