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 --
10 -- Copyright (C) 1991-2001 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
41 -- or remove the pragma Elaborate_Body.
42 -- It is designed to be a bottom-level (leaf) package.
45 package System
.OS_Interface
is
48 pragma Linker_Options
("--for-linker=sys$library:pthread$rtl.exe");
49 -- Link in the DEC threads library.
51 -- pragma Linker_Options ("--for-linker=/threads_enable");
52 -- Enable upcalls and multiple kernel threads.
54 subtype int
is Interfaces
.C
.int
;
55 subtype short
is Interfaces
.C
.short
;
56 subtype long
is Interfaces
.C
.long
;
57 subtype unsigned
is Interfaces
.C
.unsigned
;
58 subtype unsigned_short
is Interfaces
.C
.unsigned_short
;
59 subtype unsigned_long
is Interfaces
.C
.unsigned_long
;
60 subtype unsigned_char
is Interfaces
.C
.unsigned_char
;
61 subtype plain_char
is Interfaces
.C
.plain_char
;
62 subtype size_t
is Interfaces
.C
.size_t
;
64 -----------------------------
65 -- Signals (Interrupt IDs) --
66 -----------------------------
68 -- Type signal has an arbitrary limit of 31
70 Max_Interrupt
: constant := 31;
71 type Signal
is new unsigned
range 0 .. Max_Interrupt
;
72 for Signal
'Size use unsigned
'Size;
74 type sigset_t
is array (Signal
) of Boolean;
75 pragma Pack
(sigset_t
);
77 -- Interrupt_Number_Type
78 -- Unsigned long integer denoting the number of an interrupt
80 subtype Interrupt_Number_Type
is unsigned_long
;
82 -- OpenVMS system services return values of type Cond_Value_Type.
84 subtype Cond_Value_Type
is unsigned_long
;
85 subtype Short_Cond_Value_Type
is unsigned_short
;
87 type IO_Status_Block_Type
is record
88 Status
: Short_Cond_Value_Type
;
89 Count
: unsigned_short
;
90 Dev_Info
: unsigned_long
;
93 type AST_Handler
is access procedure (Param
: Address
);
94 No_AST_Handler
: constant AST_Handler
:= null;
96 CMB_M_READONLY
: constant := 16#
00000001#
;
97 CMB_M_WRITEONLY
: constant := 16#
00000002#
;
98 AGN_M_READONLY
: constant := 16#
00000001#
;
99 AGN_M_WRITEONLY
: constant := 16#
00000002#
;
101 IO_WRITEVBLK
: constant := 48; -- WRITE VIRTUAL BLOCK
102 IO_READVBLK
: constant := 49; -- READ VIRTUAL BLOCK
108 -- Assign I/O Channel
110 -- Status = returned status
111 -- Devnam = address of device name or logical name string
113 -- Chan = address of word to receive channel number assigned
114 -- Acmode = access mode associated with channel
115 -- Mbxnam = address of mailbox logical name string descriptor, if
116 -- mailbox associated with device
117 -- Flags = optional channel flags longword for specifying options
118 -- for the $ASSIGN operation
122 (Status
: out Cond_Value_Type
;
124 Chan
: out unsigned_short
;
125 Acmode
: in unsigned_short
:= 0;
126 Mbxnam
: in String := String'Null_Parameter;
127 Flags
: in unsigned_long
:= 0);
128 pragma Interface
(External
, Sys_Assign
);
129 pragma Import_Valued_Procedure
130 (Sys_Assign
, "SYS$ASSIGN",
131 (Cond_Value_Type
, String, unsigned_short
,
132 unsigned_short
, String, unsigned_long
),
133 (Value
, Descriptor
(s
), Reference
,
134 Value
, Descriptor
(s
), Value
),
143 -- Status = returned status
144 -- Reqidt = ID of timer to be cancelled
145 -- Acmode = Access mode
148 (Status
: out Cond_Value_Type
;
150 Acmode
: in unsigned
);
151 pragma Interface
(External
, Sys_Cantim
);
152 pragma Import_Valued_Procedure
153 (Sys_Cantim
, "SYS$CANTIM",
154 (Cond_Value_Type
, Address
, unsigned
),
155 (Value
, Value
, Value
));
163 -- Status = returned status
164 -- Prmflg = permanent flag
166 -- Maxmsg = maximum message
167 -- Bufquo = buufer quote
168 -- Promsk = protection mast
169 -- Acmode = access mode
170 -- Lognam = logical name
174 (Status
: out Cond_Value_Type
;
176 Chan
: out unsigned_short
;
177 Maxmsg
: in unsigned_long
:= 0;
178 Bufquo
: in unsigned_long
:= 0;
179 Promsk
: in unsigned_short
:= 0;
180 Acmode
: in unsigned_short
:= 0;
182 Flags
: in unsigned_long
:= 0);
183 pragma Interface
(External
, Sys_Crembx
);
184 pragma Import_Valued_Procedure
185 (Sys_Crembx
, "SYS$CREMBX",
186 (Cond_Value_Type
, Boolean, unsigned_short
,
187 unsigned_long
, unsigned_long
, unsigned_short
,
188 unsigned_short
, String, unsigned_long
),
189 (Value
, Value
, Reference
,
191 Value
, Descriptor
(s
), Value
));
199 -- Status = Returned status of call
200 -- EFN = event flag to be set when I/O completes
203 -- Iosb = I/O status block
204 -- Astadr = system trap to be generated when I/O completes
205 -- Astprm = AST parameter
206 -- P1-6 = optional parameters
209 (Status
: out Cond_Value_Type
;
210 EFN
: in unsigned_long
:= 0;
211 Chan
: in unsigned_short
;
212 Func
: in unsigned_long
:= 0;
213 Iosb
: out IO_Status_Block_Type
;
214 Astadr
: in AST_Handler
:= No_AST_Handler
;
215 Astprm
: in Address
:= Null_Address
;
216 P1
: in unsigned_long
:= 0;
217 P2
: in unsigned_long
:= 0;
218 P3
: in unsigned_long
:= 0;
219 P4
: in unsigned_long
:= 0;
220 P5
: in unsigned_long
:= 0;
221 P6
: in unsigned_long
:= 0);
224 (Status
: out Cond_Value_Type
;
225 EFN
: in unsigned_long
:= 0;
226 Chan
: in unsigned_short
;
227 Func
: in unsigned_long
:= 0;
228 Iosb
: in Address
:= Null_Address
;
229 Astadr
: in AST_Handler
:= No_AST_Handler
;
230 Astprm
: in Address
:= Null_Address
;
231 P1
: in unsigned_long
:= 0;
232 P2
: in unsigned_long
:= 0;
233 P3
: in unsigned_long
:= 0;
234 P4
: in unsigned_long
:= 0;
235 P5
: in unsigned_long
:= 0;
236 P6
: in unsigned_long
:= 0);
238 pragma Interface
(External
, Sys_QIO
);
239 pragma Import_Valued_Procedure
241 (Cond_Value_Type
, unsigned_long
, unsigned_short
, unsigned_long
,
242 IO_Status_Block_Type
, AST_Handler
, Address
,
243 unsigned_long
, unsigned_long
, unsigned_long
,
244 unsigned_long
, unsigned_long
, unsigned_long
),
245 (Value
, Value
, Value
, Value
,
246 Reference
, Value
, Value
,
248 Value
, Value
, Value
));
250 pragma Import_Valued_Procedure
252 (Cond_Value_Type
, unsigned_long
, unsigned_short
, unsigned_long
,
253 Address
, AST_Handler
, Address
,
254 unsigned_long
, unsigned_long
, unsigned_long
,
255 unsigned_long
, unsigned_long
, unsigned_long
),
256 (Value
, Value
, Value
, Value
,
259 Value
, Value
, Value
));
267 -- Status = Returned status of call
268 -- EFN = event flag to be set when timer expires
269 -- Tim = expiration time
270 -- AST = system trap to be generated when timer expires
271 -- Redidt = returned ID of timer (e.g. to cancel timer)
275 (Status
: out Cond_Value_Type
;
276 EFN
: in unsigned_long
;
277 Tim
: in Long_Integer;
278 AST
: in AST_Handler
;
280 Flags
: in unsigned_long
);
281 pragma Interface
(External
, Sys_Setimr
);
282 pragma Import_Valued_Procedure
283 (Sys_Setimr
, "SYS$SETIMR",
284 (Cond_Value_Type
, unsigned_long
, Long_Integer,
285 AST_Handler
, Address
, unsigned_long
),
286 (Value
, Value
, Reference
,
287 Value
, Value
, Value
));
289 Interrupt_ID_0
: constant := 0;
290 Interrupt_ID_1
: constant := 1;
291 Interrupt_ID_2
: constant := 2;
292 Interrupt_ID_3
: constant := 3;
293 Interrupt_ID_4
: constant := 4;
294 Interrupt_ID_5
: constant := 5;
295 Interrupt_ID_6
: constant := 6;
296 Interrupt_ID_7
: constant := 7;
297 Interrupt_ID_8
: constant := 8;
298 Interrupt_ID_9
: constant := 9;
299 Interrupt_ID_10
: constant := 10;
300 Interrupt_ID_11
: constant := 11;
301 Interrupt_ID_12
: constant := 12;
302 Interrupt_ID_13
: constant := 13;
303 Interrupt_ID_14
: constant := 14;
304 Interrupt_ID_15
: constant := 15;
305 Interrupt_ID_16
: constant := 16;
306 Interrupt_ID_17
: constant := 17;
307 Interrupt_ID_18
: constant := 18;
308 Interrupt_ID_19
: constant := 19;
309 Interrupt_ID_20
: constant := 20;
310 Interrupt_ID_21
: constant := 21;
311 Interrupt_ID_22
: constant := 22;
312 Interrupt_ID_23
: constant := 23;
313 Interrupt_ID_24
: constant := 24;
314 Interrupt_ID_25
: constant := 25;
315 Interrupt_ID_26
: constant := 26;
316 Interrupt_ID_27
: constant := 27;
317 Interrupt_ID_28
: constant := 28;
318 Interrupt_ID_29
: constant := 29;
319 Interrupt_ID_30
: constant := 30;
320 Interrupt_ID_31
: constant := 31;
326 function errno
return int
;
327 pragma Import
(C
, errno
, "__get_errno");
329 EINTR
: constant := 4; -- Interrupted system call
330 EAGAIN
: constant := 11; -- No more processes
331 ENOMEM
: constant := 12; -- Not enough core
333 -------------------------
334 -- Priority Scheduling --
335 -------------------------
337 SCHED_FIFO
: constant := 1;
338 SCHED_RR
: constant := 2;
339 SCHED_OTHER
: constant := 3;
340 SCHED_BG
: constant := 4;
341 SCHED_LFI
: constant := 5;
342 SCHED_LRR
: constant := 6;
348 type pid_t
is private;
350 function kill
(pid
: pid_t
; sig
: Signal
) return int
;
351 pragma Import
(C
, kill
);
353 function getpid
return pid_t
;
354 pragma Import
(C
, getpid
);
360 type Thread_Body
is access
361 function (arg
: System
.Address
) return System
.Address
;
362 type pthread_t
is private;
363 subtype Thread_Id
is pthread_t
;
365 type pthread_mutex_t
is limited private;
366 type pthread_cond_t
is limited private;
367 type pthread_attr_t
is limited private;
368 type pthread_mutexattr_t
is limited private;
369 type pthread_condattr_t
is limited private;
370 type pthread_key_t
is private;
372 PTHREAD_CREATE_JOINABLE
: constant := 0;
373 PTHREAD_CREATE_DETACHED
: constant := 1;
375 PTHREAD_CANCEL_DISABLE
: constant := 0;
376 PTHREAD_CANCEL_ENABLE
: constant := 1;
378 PTHREAD_CANCEL_DEFERRED
: constant := 0;
379 PTHREAD_CANCEL_ASYNCHRONOUS
: constant := 1;
381 -- Don't use ERRORCHECK mutexes, they don't work when a thread is not
382 -- the owner. AST's, at least, unlock others threads mutexes. Even
383 -- if the error is ignored, they don't work.
384 PTHREAD_MUTEX_NORMAL_NP
: constant := 0;
385 PTHREAD_MUTEX_RECURSIVE_NP
: constant := 1;
386 PTHREAD_MUTEX_ERRORCHECK_NP
: constant := 2;
388 PTHREAD_INHERIT_SCHED
: constant := 0;
389 PTHREAD_EXPLICIT_SCHED
: constant := 1;
391 function pthread_cancel
(thread
: pthread_t
) return int
;
392 pragma Import
(C
, pthread_cancel
, "PTHREAD_CANCEL");
394 procedure pthread_testcancel
;
395 pragma Import
(C
, pthread_testcancel
, "PTHREAD_TESTCANCEL");
397 function pthread_setcancelstate
398 (newstate
: int
; oldstate
: access int
) return int
;
399 pragma Import
(C
, pthread_setcancelstate
, "PTHREAD_SETCANCELSTATE");
401 function pthread_setcanceltype
402 (newtype
: int
; oldtype
: access int
) return int
;
403 pragma Import
(C
, pthread_setcanceltype
, "PTHREAD_SETCANCELTYPE");
405 ---------------------------
406 -- POSIX.1c Section 3 --
407 ---------------------------
409 function pthread_lock_global_np
return int
;
410 pragma Import
(C
, pthread_lock_global_np
, "PTHREAD_LOCK_GLOBAL_NP");
412 function pthread_unlock_global_np
return int
;
413 pragma Import
(C
, pthread_unlock_global_np
, "PTHREAD_UNLOCK_GLOBAL_NP");
415 ----------------------------
416 -- POSIX.1c Section 11 --
417 ----------------------------
419 function pthread_mutexattr_init
420 (attr
: access pthread_mutexattr_t
) return int
;
421 pragma Import
(C
, pthread_mutexattr_init
, "PTHREAD_MUTEXATTR_INIT");
423 function pthread_mutexattr_destroy
424 (attr
: access pthread_mutexattr_t
) return int
;
425 pragma Import
(C
, pthread_mutexattr_destroy
, "PTHREAD_MUTEXATTR_DESTROY");
427 function pthread_mutexattr_settype_np
428 (attr
: access pthread_mutexattr_t
;
429 mutextype
: int
) return int
;
430 pragma Import
(C
, pthread_mutexattr_settype_np
,
431 "PTHREAD_MUTEXATTR_SETTYPE_NP");
433 function pthread_mutex_init
434 (mutex
: access pthread_mutex_t
;
435 attr
: access pthread_mutexattr_t
) return int
;
436 pragma Import
(C
, pthread_mutex_init
, "PTHREAD_MUTEX_INIT");
438 function pthread_mutex_destroy
(mutex
: access pthread_mutex_t
) return int
;
439 pragma Import
(C
, pthread_mutex_destroy
, "PTHREAD_MUTEX_DESTROY");
441 function pthread_mutex_lock
(mutex
: access pthread_mutex_t
) return int
;
442 pragma Import
(C
, pthread_mutex_lock
, "PTHREAD_MUTEX_LOCK");
444 function pthread_mutex_unlock
(mutex
: access pthread_mutex_t
) return int
;
445 pragma Import
(C
, pthread_mutex_unlock
, "PTHREAD_MUTEX_UNLOCK");
447 function pthread_condattr_init
448 (attr
: access pthread_condattr_t
) return int
;
449 pragma Import
(C
, pthread_condattr_init
, "PTHREAD_CONDATTR_INIT");
451 function pthread_condattr_destroy
452 (attr
: access pthread_condattr_t
) return int
;
453 pragma Import
(C
, pthread_condattr_destroy
, "PTHREAD_CONDATTR_DESTROY");
455 function pthread_cond_init
456 (cond
: access pthread_cond_t
;
457 attr
: access pthread_condattr_t
) return int
;
458 pragma Import
(C
, pthread_cond_init
, "PTHREAD_COND_INIT");
460 function pthread_cond_destroy
(cond
: access pthread_cond_t
) return int
;
461 pragma Import
(C
, pthread_cond_destroy
, "PTHREAD_COND_DESTROY");
463 function pthread_cond_signal
(cond
: access pthread_cond_t
) return int
;
464 pragma Import
(C
, pthread_cond_signal
, "PTHREAD_COND_SIGNAL");
466 function pthread_cond_signal_int_np
467 (cond
: access pthread_cond_t
) return int
;
468 pragma Import
(C
, pthread_cond_signal_int_np
,
469 "PTHREAD_COND_SIGNAL_INT_NP");
471 function pthread_cond_wait
472 (cond
: access pthread_cond_t
;
473 mutex
: access pthread_mutex_t
) return int
;
474 pragma Import
(C
, pthread_cond_wait
, "PTHREAD_COND_WAIT");
476 --------------------------
477 -- POSIX.1c Section 13 --
478 --------------------------
480 function pthread_mutexattr_setprotocol
481 (attr
: access pthread_mutexattr_t
; protocol
: int
) return int
;
482 pragma Import
(C
, pthread_mutexattr_setprotocol
,
483 "PTHREAD_MUTEXATTR_SETPROTOCOL");
485 type struct_sched_param
is record
486 sched_priority
: int
; -- scheduling priority
488 for struct_sched_param
'Size use 8*4;
489 pragma Convention
(C
, struct_sched_param
);
491 function pthread_setschedparam
494 param
: access struct_sched_param
) return int
;
495 pragma Import
(C
, pthread_setschedparam
, "PTHREAD_SETSCHEDPARAM");
497 function pthread_attr_setscope
498 (attr
: access pthread_attr_t
;
499 contentionscope
: int
) return int
;
500 pragma Import
(C
, pthread_attr_setscope
, "PTHREAD_ATTR_SETSCOPE");
502 function pthread_attr_setinheritsched
503 (attr
: access pthread_attr_t
;
504 inheritsched
: int
) return int
;
505 pragma Import
(C
, pthread_attr_setinheritsched
,
506 "PTHREAD_ATTR_SETINHERITSCHED");
508 function pthread_attr_setschedpolicy
509 (attr
: access pthread_attr_t
; policy
: int
) return int
;
510 pragma Import
(C
, pthread_attr_setschedpolicy
,
511 "PTHREAD_ATTR_SETSCHEDPOLICY");
513 function pthread_attr_setschedparam
514 (attr
: access pthread_attr_t
;
515 sched_param
: int
) return int
;
516 pragma Import
(C
, pthread_attr_setschedparam
, "PTHREAD_ATTR_SETSCHEDPARAM");
518 function sched_yield
return int
;
520 -----------------------------
521 -- P1003.1c - Section 16 --
522 -----------------------------
524 function pthread_attr_init
(attributes
: access pthread_attr_t
) return int
;
525 pragma Import
(C
, pthread_attr_init
, "PTHREAD_ATTR_INIT");
527 function pthread_attr_destroy
528 (attributes
: access pthread_attr_t
) return int
;
529 pragma Import
(C
, pthread_attr_destroy
, "PTHREAD_ATTR_DESTROY");
531 function pthread_attr_setdetachstate
532 (attr
: access pthread_attr_t
;
533 detachstate
: int
) return int
;
534 pragma Import
(C
, pthread_attr_setdetachstate
,
535 "PTHREAD_ATTR_SETDETACHSTATE");
537 function pthread_attr_setstacksize
538 (attr
: access pthread_attr_t
;
539 stacksize
: size_t
) return int
;
540 pragma Import
(C
, pthread_attr_setstacksize
, "PTHREAD_ATTR_SETSTACKSIZE");
542 function pthread_create
543 (thread
: access pthread_t
;
544 attributes
: access pthread_attr_t
;
545 start_routine
: Thread_Body
;
546 arg
: System
.Address
) return int
;
547 pragma Import
(C
, pthread_create
, "PTHREAD_CREATE");
549 procedure pthread_exit
(status
: System
.Address
);
550 pragma Import
(C
, pthread_exit
, "PTHREAD_EXIT");
552 function pthread_self
return pthread_t
;
553 pragma Import
(C
, pthread_self
, "PTHREAD_SELF");
555 --------------------------
556 -- POSIX.1c Section 17 --
557 --------------------------
559 function pthread_setspecific
560 (key
: pthread_key_t
;
561 value
: System
.Address
) return int
;
562 pragma Import
(C
, pthread_setspecific
, "PTHREAD_SETSPECIFIC");
564 function pthread_getspecific
(key
: pthread_key_t
) return System
.Address
;
565 pragma Import
(C
, pthread_getspecific
, "PTHREAD_GETSPECIFIC");
567 type destructor_pointer
is access procedure (arg
: System
.Address
);
569 function pthread_key_create
570 (key
: access pthread_key_t
;
571 destructor
: destructor_pointer
) return int
;
572 pragma Import
(C
, pthread_key_create
, "PTHREAD_KEY_CREATE");
576 type pid_t
is new int
;
578 type pthreadLongAddr_p
is mod 2 ** Long_Integer'Size;
580 type pthreadLongAddr_t
is mod 2 ** Long_Integer'Size;
581 type pthreadLongAddr_t_ptr
is mod 2 ** Long_Integer'Size;
583 type pthreadLongString_t
is mod 2 ** Long_Integer'Size;
585 type pthreadLongUint_t
is mod 2 ** Long_Integer'Size;
586 type pthreadLongUint_array
is array (Natural range <>)
587 of pthreadLongUint_t
;
589 type pthread_t
is mod 2 ** Long_Integer'Size;
591 type pthread_cond_t
is record
594 name
: pthreadLongString_t
;
597 block
: pthreadLongAddr_t_ptr
;
599 for pthread_cond_t
'Size use 8*32;
600 pragma Convention
(C
, pthread_cond_t
);
602 type pthread_attr_t
is record
604 name
: pthreadLongString_t
;
605 arg
: pthreadLongUint_t
;
606 reserved
: pthreadLongUint_array
(0 .. 18);
608 for pthread_attr_t
'Size use 8*176;
609 pragma Convention
(C
, pthread_attr_t
);
611 type pthread_mutex_t
is record
614 name
: pthreadLongString_t
;
617 block
: pthreadLongAddr_p
;
621 for pthread_mutex_t
'Size use 8*40;
622 pragma Convention
(C
, pthread_mutex_t
);
624 type pthread_mutexattr_t
is record
626 reserved
: pthreadLongUint_array
(0 .. 14);
628 for pthread_mutexattr_t
'Size use 8*128;
629 pragma Convention
(C
, pthread_mutexattr_t
);
631 type pthread_condattr_t
is record
633 reserved
: pthreadLongUint_array
(0 .. 12);
635 for pthread_condattr_t
'Size use 8*112;
636 pragma Convention
(C
, pthread_condattr_t
);
638 type pthread_key_t
is new unsigned
;
640 end System
.OS_Interface
;