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-1994, Florida State University --
10 -- Copyright (C) 1995-2004, Free Software Foundation, Inc. --
12 -- GNARL is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNARL; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNARL was developed by the GNARL team at Florida State University. --
31 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
33 ------------------------------------------------------------------------------
35 -- This is a OpenVMS/Alpha version of this package
37 -- This package encapsulates all direct interfaces to OS services
38 -- that are needed by children of System.
40 -- PLEASE DO NOT add any with-clauses to this package or remove the pragma
41 -- Preelaborate. This package is designed to be a bottom-level (leaf) package.
44 with Unchecked_Conversion
;
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
;
364 function Thread_Body_Access
is new
365 Unchecked_Conversion
(System
.Address
, Thread_Body
);
367 type pthread_t
is private;
368 subtype Thread_Id
is pthread_t
;
370 type pthread_mutex_t
is limited private;
371 type pthread_cond_t
is limited private;
372 type pthread_attr_t
is limited private;
373 type pthread_mutexattr_t
is limited private;
374 type pthread_condattr_t
is limited private;
375 type pthread_key_t
is private;
377 PTHREAD_CREATE_JOINABLE
: constant := 0;
378 PTHREAD_CREATE_DETACHED
: constant := 1;
380 PTHREAD_CANCEL_DISABLE
: constant := 0;
381 PTHREAD_CANCEL_ENABLE
: constant := 1;
383 PTHREAD_CANCEL_DEFERRED
: constant := 0;
384 PTHREAD_CANCEL_ASYNCHRONOUS
: constant := 1;
386 -- Don't use ERRORCHECK mutexes, they don't work when a thread is not
387 -- the owner. AST's, at least, unlock others threads mutexes. Even
388 -- if the error is ignored, they don't work.
389 PTHREAD_MUTEX_NORMAL_NP
: constant := 0;
390 PTHREAD_MUTEX_RECURSIVE_NP
: constant := 1;
391 PTHREAD_MUTEX_ERRORCHECK_NP
: constant := 2;
393 PTHREAD_INHERIT_SCHED
: constant := 0;
394 PTHREAD_EXPLICIT_SCHED
: constant := 1;
396 function pthread_cancel
(thread
: pthread_t
) return int
;
397 pragma Import
(C
, pthread_cancel
, "PTHREAD_CANCEL");
399 procedure pthread_testcancel
;
400 pragma Import
(C
, pthread_testcancel
, "PTHREAD_TESTCANCEL");
402 function pthread_setcancelstate
403 (newstate
: int
; oldstate
: access int
) return int
;
404 pragma Import
(C
, pthread_setcancelstate
, "PTHREAD_SETCANCELSTATE");
406 function pthread_setcanceltype
407 (newtype
: int
; oldtype
: access int
) return int
;
408 pragma Import
(C
, pthread_setcanceltype
, "PTHREAD_SETCANCELTYPE");
410 -------------------------
411 -- POSIX.1c Section 3 --
412 -------------------------
414 function pthread_lock_global_np
return int
;
415 pragma Import
(C
, pthread_lock_global_np
, "PTHREAD_LOCK_GLOBAL_NP");
417 function pthread_unlock_global_np
return int
;
418 pragma Import
(C
, pthread_unlock_global_np
, "PTHREAD_UNLOCK_GLOBAL_NP");
420 --------------------------
421 -- POSIX.1c Section 11 --
422 --------------------------
424 function pthread_mutexattr_init
425 (attr
: access pthread_mutexattr_t
) return int
;
426 pragma Import
(C
, pthread_mutexattr_init
, "PTHREAD_MUTEXATTR_INIT");
428 function pthread_mutexattr_destroy
429 (attr
: access pthread_mutexattr_t
) return int
;
430 pragma Import
(C
, pthread_mutexattr_destroy
, "PTHREAD_MUTEXATTR_DESTROY");
432 function pthread_mutexattr_settype_np
433 (attr
: access pthread_mutexattr_t
;
434 mutextype
: int
) return int
;
435 pragma Import
(C
, pthread_mutexattr_settype_np
,
436 "PTHREAD_MUTEXATTR_SETTYPE_NP");
438 function pthread_mutex_init
439 (mutex
: access pthread_mutex_t
;
440 attr
: access pthread_mutexattr_t
) return int
;
441 pragma Import
(C
, pthread_mutex_init
, "PTHREAD_MUTEX_INIT");
443 function pthread_mutex_destroy
(mutex
: access pthread_mutex_t
) return int
;
444 pragma Import
(C
, pthread_mutex_destroy
, "PTHREAD_MUTEX_DESTROY");
446 function pthread_mutex_lock
(mutex
: access pthread_mutex_t
) return int
;
447 pragma Import
(C
, pthread_mutex_lock
, "PTHREAD_MUTEX_LOCK");
449 function pthread_mutex_unlock
(mutex
: access pthread_mutex_t
) return int
;
450 pragma Import
(C
, pthread_mutex_unlock
, "PTHREAD_MUTEX_UNLOCK");
452 function pthread_condattr_init
453 (attr
: access pthread_condattr_t
) return int
;
454 pragma Import
(C
, pthread_condattr_init
, "PTHREAD_CONDATTR_INIT");
456 function pthread_condattr_destroy
457 (attr
: access pthread_condattr_t
) return int
;
458 pragma Import
(C
, pthread_condattr_destroy
, "PTHREAD_CONDATTR_DESTROY");
460 function pthread_cond_init
461 (cond
: access pthread_cond_t
;
462 attr
: access pthread_condattr_t
) return int
;
463 pragma Import
(C
, pthread_cond_init
, "PTHREAD_COND_INIT");
465 function pthread_cond_destroy
(cond
: access pthread_cond_t
) return int
;
466 pragma Import
(C
, pthread_cond_destroy
, "PTHREAD_COND_DESTROY");
468 function pthread_cond_signal
(cond
: access pthread_cond_t
) return int
;
469 pragma Import
(C
, pthread_cond_signal
, "PTHREAD_COND_SIGNAL");
471 function pthread_cond_signal_int_np
472 (cond
: access pthread_cond_t
) return int
;
473 pragma Import
(C
, pthread_cond_signal_int_np
,
474 "PTHREAD_COND_SIGNAL_INT_NP");
476 function pthread_cond_wait
477 (cond
: access pthread_cond_t
;
478 mutex
: access pthread_mutex_t
) return int
;
479 pragma Import
(C
, pthread_cond_wait
, "PTHREAD_COND_WAIT");
481 --------------------------
482 -- POSIX.1c Section 13 --
483 --------------------------
485 function pthread_mutexattr_setprotocol
486 (attr
: access pthread_mutexattr_t
; protocol
: int
) return int
;
487 pragma Import
(C
, pthread_mutexattr_setprotocol
,
488 "PTHREAD_MUTEXATTR_SETPROTOCOL");
490 type struct_sched_param
is record
491 sched_priority
: int
; -- scheduling priority
493 for struct_sched_param
'Size use 8*4;
494 pragma Convention
(C
, struct_sched_param
);
496 function pthread_setschedparam
499 param
: access struct_sched_param
) return int
;
500 pragma Import
(C
, pthread_setschedparam
, "PTHREAD_SETSCHEDPARAM");
502 function pthread_attr_setscope
503 (attr
: access pthread_attr_t
;
504 contentionscope
: int
) return int
;
505 pragma Import
(C
, pthread_attr_setscope
, "PTHREAD_ATTR_SETSCOPE");
507 function pthread_attr_setinheritsched
508 (attr
: access pthread_attr_t
;
509 inheritsched
: int
) return int
;
510 pragma Import
(C
, pthread_attr_setinheritsched
,
511 "PTHREAD_ATTR_SETINHERITSCHED");
513 function pthread_attr_setschedpolicy
514 (attr
: access pthread_attr_t
; policy
: int
) return int
;
515 pragma Import
(C
, pthread_attr_setschedpolicy
,
516 "PTHREAD_ATTR_SETSCHEDPOLICY");
518 function pthread_attr_setschedparam
519 (attr
: access pthread_attr_t
;
520 sched_param
: int
) return int
;
521 pragma Import
(C
, pthread_attr_setschedparam
, "PTHREAD_ATTR_SETSCHEDPARAM");
523 function sched_yield
return int
;
525 --------------------------
526 -- P1003.1c Section 16 --
527 --------------------------
529 function pthread_attr_init
(attributes
: access pthread_attr_t
) return int
;
530 pragma Import
(C
, pthread_attr_init
, "PTHREAD_ATTR_INIT");
532 function pthread_attr_destroy
533 (attributes
: access pthread_attr_t
) return int
;
534 pragma Import
(C
, pthread_attr_destroy
, "PTHREAD_ATTR_DESTROY");
536 function pthread_attr_setdetachstate
537 (attr
: access pthread_attr_t
;
538 detachstate
: int
) return int
;
539 pragma Import
(C
, pthread_attr_setdetachstate
,
540 "PTHREAD_ATTR_SETDETACHSTATE");
542 function pthread_attr_setstacksize
543 (attr
: access pthread_attr_t
;
544 stacksize
: size_t
) return int
;
545 pragma Import
(C
, pthread_attr_setstacksize
, "PTHREAD_ATTR_SETSTACKSIZE");
547 function pthread_create
548 (thread
: access pthread_t
;
549 attributes
: access pthread_attr_t
;
550 start_routine
: Thread_Body
;
551 arg
: System
.Address
) return int
;
552 pragma Import
(C
, pthread_create
, "PTHREAD_CREATE");
554 procedure pthread_exit
(status
: System
.Address
);
555 pragma Import
(C
, pthread_exit
, "PTHREAD_EXIT");
557 function pthread_self
return pthread_t
;
559 --------------------------
560 -- POSIX.1c Section 17 --
561 --------------------------
563 function pthread_setspecific
564 (key
: pthread_key_t
;
565 value
: System
.Address
) return int
;
566 pragma Import
(C
, pthread_setspecific
, "PTHREAD_SETSPECIFIC");
568 function pthread_getspecific
(key
: pthread_key_t
) return System
.Address
;
569 pragma Import
(C
, pthread_getspecific
, "PTHREAD_GETSPECIFIC");
571 type destructor_pointer
is access procedure (arg
: System
.Address
);
573 function pthread_key_create
574 (key
: access pthread_key_t
;
575 destructor
: destructor_pointer
) return int
;
576 pragma Import
(C
, pthread_key_create
, "PTHREAD_KEY_CREATE");
580 type pid_t
is new int
;
582 type pthreadLongAddr_p
is mod 2 ** Long_Integer'Size;
584 type pthreadLongAddr_t
is mod 2 ** Long_Integer'Size;
585 type pthreadLongAddr_t_ptr
is mod 2 ** Long_Integer'Size;
587 type pthreadLongString_t
is mod 2 ** Long_Integer'Size;
589 type pthreadLongUint_t
is mod 2 ** Long_Integer'Size;
590 type pthreadLongUint_array
is array (Natural range <>)
591 of pthreadLongUint_t
;
593 type pthread_t
is mod 2 ** Long_Integer'Size;
595 type pthread_cond_t
is record
598 name
: pthreadLongString_t
;
601 block
: pthreadLongAddr_t_ptr
;
603 for pthread_cond_t
'Size use 8*32;
604 pragma Convention
(C
, pthread_cond_t
);
606 type pthread_attr_t
is record
608 name
: pthreadLongString_t
;
609 arg
: pthreadLongUint_t
;
610 reserved
: pthreadLongUint_array
(0 .. 18);
612 for pthread_attr_t
'Size use 8*176;
613 pragma Convention
(C
, pthread_attr_t
);
615 type pthread_mutex_t
is record
618 name
: pthreadLongString_t
;
621 block
: pthreadLongAddr_p
;
625 for pthread_mutex_t
'Size use 8*40;
626 pragma Convention
(C
, pthread_mutex_t
);
628 type pthread_mutexattr_t
is record
630 reserved
: pthreadLongUint_array
(0 .. 14);
632 for pthread_mutexattr_t
'Size use 8*128;
633 pragma Convention
(C
, pthread_mutexattr_t
);
635 type pthread_condattr_t
is record
637 reserved
: pthreadLongUint_array
(0 .. 12);
639 for pthread_condattr_t
'Size use 8*112;
640 pragma Convention
(C
, pthread_condattr_t
);
642 type pthread_key_t
is new unsigned
;
644 pragma Inline
(pthread_self
);
646 end System
.OS_Interface
;