]>
Commit | Line | Data |
---|---|---|
e6e7bf38 | 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 | -- -- | |
3670c51d | 9 | -- Copyright (C) 1991-2002 Free Software Foundation, Inc. -- |
e6e7bf38 | 10 | -- -- |
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. -- | |
21 | -- -- | |
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. -- | |
28 | -- -- | |
e78e8c8e | 29 | -- GNARL was developed by the GNARL team at Florida State University. -- |
9dfe12ae | 30 | -- Extensive contributions were provided by Ada Core Technologies, Inc. -- |
e6e7bf38 | 31 | -- -- |
32 | ------------------------------------------------------------------------------ | |
33 | ||
34 | -- This is a OpenVMS/Alpha version of this package. | |
35 | ||
36 | -- This package encapsulates all direct interfaces to OS services | |
37 | -- that are needed by children of System. | |
38 | ||
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. | |
42 | ||
43 | with Interfaces.C; | |
44 | package System.OS_Interface is | |
45 | pragma Preelaborate; | |
46 | ||
47 | pragma Linker_Options ("--for-linker=sys$library:pthread$rtl.exe"); | |
48 | -- Link in the DEC threads library. | |
49 | ||
50 | -- pragma Linker_Options ("--for-linker=/threads_enable"); | |
51 | -- Enable upcalls and multiple kernel threads. | |
52 | ||
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; | |
62 | ||
63 | ----------------------------- | |
64 | -- Signals (Interrupt IDs) -- | |
65 | ----------------------------- | |
66 | ||
67 | -- Type signal has an arbitrary limit of 31 | |
68 | ||
69 | Max_Interrupt : constant := 31; | |
70 | type Signal is new unsigned range 0 .. Max_Interrupt; | |
71 | for Signal'Size use unsigned'Size; | |
72 | ||
73 | type sigset_t is array (Signal) of Boolean; | |
74 | pragma Pack (sigset_t); | |
75 | ||
76 | -- Interrupt_Number_Type | |
77 | -- Unsigned long integer denoting the number of an interrupt | |
78 | ||
79 | subtype Interrupt_Number_Type is unsigned_long; | |
80 | ||
81 | -- OpenVMS system services return values of type Cond_Value_Type. | |
82 | ||
83 | subtype Cond_Value_Type is unsigned_long; | |
84 | subtype Short_Cond_Value_Type is unsigned_short; | |
85 | ||
86 | type IO_Status_Block_Type is record | |
87 | Status : Short_Cond_Value_Type; | |
88 | Count : unsigned_short; | |
89 | Dev_Info : unsigned_long; | |
90 | end record; | |
91 | ||
92 | type AST_Handler is access procedure (Param : Address); | |
93 | No_AST_Handler : constant AST_Handler := null; | |
94 | ||
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#; | |
99 | ||
100 | IO_WRITEVBLK : constant := 48; -- WRITE VIRTUAL BLOCK | |
101 | IO_READVBLK : constant := 49; -- READ VIRTUAL BLOCK | |
102 | ||
103 | ---------------- | |
104 | -- Sys_Assign -- | |
105 | ---------------- | |
106 | -- | |
107 | -- Assign I/O Channel | |
108 | -- | |
109 | -- Status = returned status | |
110 | -- Devnam = address of device name or logical name string | |
111 | -- descriptor | |
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 | |
118 | -- | |
119 | ||
120 | procedure Sys_Assign | |
121 | (Status : out Cond_Value_Type; | |
122 | Devnam : in String; | |
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), | |
134 | Flags); | |
135 | ||
136 | ---------------- | |
137 | -- Sys_Cantim -- | |
138 | ---------------- | |
139 | -- | |
140 | -- Cancel Timer | |
141 | -- | |
142 | -- Status = returned status | |
143 | -- Reqidt = ID of timer to be cancelled | |
144 | -- Acmode = Access mode | |
145 | -- | |
146 | procedure Sys_Cantim | |
147 | (Status : out Cond_Value_Type; | |
148 | Reqidt : in Address; | |
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)); | |
155 | ||
156 | ---------------- | |
157 | -- Sys_Crembx -- | |
158 | ---------------- | |
159 | -- | |
160 | -- Create mailbox | |
161 | -- | |
162 | -- Status = returned status | |
163 | -- Prmflg = permanent flag | |
164 | -- Chan = channel | |
165 | -- Maxmsg = maximum message | |
166 | -- Bufquo = buufer quote | |
167 | -- Promsk = protection mast | |
168 | -- Acmode = access mode | |
169 | -- Lognam = logical name | |
170 | -- Flags = flags | |
171 | -- | |
172 | procedure Sys_Crembx | |
173 | (Status : out Cond_Value_Type; | |
174 | Prmflg : in Boolean; | |
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; | |
180 | Lognam : in String; | |
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, | |
189 | Value, Value, Value, | |
190 | Value, Descriptor (s), Value)); | |
191 | ||
192 | ------------- | |
193 | -- Sys_QIO -- | |
194 | ------------- | |
195 | -- | |
196 | -- Queue I/O | |
197 | -- | |
198 | -- Status = Returned status of call | |
199 | -- EFN = event flag to be set when I/O completes | |
200 | -- Chan = channel | |
201 | -- Func = function | |
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 | |
206 | ||
207 | procedure Sys_QIO | |
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); | |
221 | ||
222 | procedure Sys_QIO | |
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); | |
236 | ||
237 | pragma Interface (External, Sys_QIO); | |
238 | pragma Import_Valued_Procedure | |
239 | (Sys_QIO, "SYS$QIO", | |
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, | |
246 | Value, Value, Value, | |
247 | Value, Value, Value)); | |
248 | ||
249 | pragma Import_Valued_Procedure | |
250 | (Sys_QIO, "SYS$QIO", | |
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, | |
256 | Value, Value, Value, | |
257 | Value, Value, Value, | |
258 | Value, Value, Value)); | |
259 | ||
260 | ---------------- | |
261 | -- Sys_Setimr -- | |
262 | ---------------- | |
263 | -- | |
264 | -- Set Timer | |
265 | -- | |
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) | |
271 | -- Flags = flags | |
272 | -- | |
273 | procedure Sys_Setimr | |
274 | (Status : out Cond_Value_Type; | |
275 | EFN : in unsigned_long; | |
276 | Tim : in Long_Integer; | |
277 | AST : in AST_Handler; | |
278 | Reqidt : in Address; | |
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)); | |
287 | ||
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; | |
320 | ||
321 | ----------- | |
322 | -- Errno -- | |
323 | ----------- | |
324 | ||
325 | function errno return int; | |
326 | pragma Import (C, errno, "__get_errno"); | |
327 | ||
328 | EINTR : constant := 4; -- Interrupted system call | |
329 | EAGAIN : constant := 11; -- No more processes | |
330 | ENOMEM : constant := 12; -- Not enough core | |
331 | ||
332 | ------------------------- | |
333 | -- Priority Scheduling -- | |
334 | ------------------------- | |
335 | ||
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; | |
342 | ||
343 | ------------- | |
344 | -- Process -- | |
345 | ------------- | |
346 | ||
347 | type pid_t is private; | |
348 | ||
349 | function kill (pid : pid_t; sig : Signal) return int; | |
350 | pragma Import (C, kill); | |
351 | ||
352 | function getpid return pid_t; | |
353 | pragma Import (C, getpid); | |
354 | ||
355 | ------------- | |
356 | -- Threads -- | |
357 | ------------- | |
358 | ||
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; | |
363 | ||
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; | |
370 | ||
371 | PTHREAD_CREATE_JOINABLE : constant := 0; | |
372 | PTHREAD_CREATE_DETACHED : constant := 1; | |
373 | ||
374 | PTHREAD_CANCEL_DISABLE : constant := 0; | |
375 | PTHREAD_CANCEL_ENABLE : constant := 1; | |
376 | ||
377 | PTHREAD_CANCEL_DEFERRED : constant := 0; | |
378 | PTHREAD_CANCEL_ASYNCHRONOUS : constant := 1; | |
379 | ||
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; | |
386 | ||
387 | PTHREAD_INHERIT_SCHED : constant := 0; | |
388 | PTHREAD_EXPLICIT_SCHED : constant := 1; | |
389 | ||
390 | function pthread_cancel (thread : pthread_t) return int; | |
391 | pragma Import (C, pthread_cancel, "PTHREAD_CANCEL"); | |
392 | ||
393 | procedure pthread_testcancel; | |
394 | pragma Import (C, pthread_testcancel, "PTHREAD_TESTCANCEL"); | |
395 | ||
396 | function pthread_setcancelstate | |
397 | (newstate : int; oldstate : access int) return int; | |
398 | pragma Import (C, pthread_setcancelstate, "PTHREAD_SETCANCELSTATE"); | |
399 | ||
400 | function pthread_setcanceltype | |
401 | (newtype : int; oldtype : access int) return int; | |
402 | pragma Import (C, pthread_setcanceltype, "PTHREAD_SETCANCELTYPE"); | |
403 | ||
404 | --------------------------- | |
405 | -- POSIX.1c Section 3 -- | |
406 | --------------------------- | |
407 | ||
408 | function pthread_lock_global_np return int; | |
409 | pragma Import (C, pthread_lock_global_np, "PTHREAD_LOCK_GLOBAL_NP"); | |
410 | ||
411 | function pthread_unlock_global_np return int; | |
412 | pragma Import (C, pthread_unlock_global_np, "PTHREAD_UNLOCK_GLOBAL_NP"); | |
413 | ||
414 | ---------------------------- | |
415 | -- POSIX.1c Section 11 -- | |
416 | ---------------------------- | |
417 | ||
418 | function pthread_mutexattr_init | |
419 | (attr : access pthread_mutexattr_t) return int; | |
420 | pragma Import (C, pthread_mutexattr_init, "PTHREAD_MUTEXATTR_INIT"); | |
421 | ||
422 | function pthread_mutexattr_destroy | |
423 | (attr : access pthread_mutexattr_t) return int; | |
424 | pragma Import (C, pthread_mutexattr_destroy, "PTHREAD_MUTEXATTR_DESTROY"); | |
425 | ||
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"); | |
431 | ||
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"); | |
436 | ||
437 | function pthread_mutex_destroy (mutex : access pthread_mutex_t) return int; | |
438 | pragma Import (C, pthread_mutex_destroy, "PTHREAD_MUTEX_DESTROY"); | |
439 | ||
440 | function pthread_mutex_lock (mutex : access pthread_mutex_t) return int; | |
441 | pragma Import (C, pthread_mutex_lock, "PTHREAD_MUTEX_LOCK"); | |
442 | ||
443 | function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int; | |
444 | pragma Import (C, pthread_mutex_unlock, "PTHREAD_MUTEX_UNLOCK"); | |
445 | ||
446 | function pthread_condattr_init | |
447 | (attr : access pthread_condattr_t) return int; | |
448 | pragma Import (C, pthread_condattr_init, "PTHREAD_CONDATTR_INIT"); | |
449 | ||
450 | function pthread_condattr_destroy | |
451 | (attr : access pthread_condattr_t) return int; | |
452 | pragma Import (C, pthread_condattr_destroy, "PTHREAD_CONDATTR_DESTROY"); | |
453 | ||
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"); | |
458 | ||
459 | function pthread_cond_destroy (cond : access pthread_cond_t) return int; | |
460 | pragma Import (C, pthread_cond_destroy, "PTHREAD_COND_DESTROY"); | |
461 | ||
462 | function pthread_cond_signal (cond : access pthread_cond_t) return int; | |
463 | pragma Import (C, pthread_cond_signal, "PTHREAD_COND_SIGNAL"); | |
464 | ||
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"); | |
469 | ||
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"); | |
474 | ||
475 | -------------------------- | |
476 | -- POSIX.1c Section 13 -- | |
477 | -------------------------- | |
478 | ||
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"); | |
483 | ||
484 | type struct_sched_param is record | |
485 | sched_priority : int; -- scheduling priority | |
486 | end record; | |
487 | for struct_sched_param'Size use 8*4; | |
488 | pragma Convention (C, struct_sched_param); | |
489 | ||
490 | function pthread_setschedparam | |
491 | (thread : pthread_t; | |
492 | policy : int; | |
493 | param : access struct_sched_param) return int; | |
494 | pragma Import (C, pthread_setschedparam, "PTHREAD_SETSCHEDPARAM"); | |
495 | ||
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"); | |
500 | ||
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"); | |
506 | ||
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"); | |
511 | ||
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"); | |
516 | ||
517 | function sched_yield return int; | |
518 | ||
519 | ----------------------------- | |
520 | -- P1003.1c - Section 16 -- | |
521 | ----------------------------- | |
522 | ||
523 | function pthread_attr_init (attributes : access pthread_attr_t) return int; | |
524 | pragma Import (C, pthread_attr_init, "PTHREAD_ATTR_INIT"); | |
525 | ||
526 | function pthread_attr_destroy | |
527 | (attributes : access pthread_attr_t) return int; | |
528 | pragma Import (C, pthread_attr_destroy, "PTHREAD_ATTR_DESTROY"); | |
529 | ||
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"); | |
535 | ||
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"); | |
540 | ||
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"); | |
547 | ||
548 | procedure pthread_exit (status : System.Address); | |
549 | pragma Import (C, pthread_exit, "PTHREAD_EXIT"); | |
550 | ||
551 | function pthread_self return pthread_t; | |
e6e7bf38 | 552 | |
553 | -------------------------- | |
554 | -- POSIX.1c Section 17 -- | |
555 | -------------------------- | |
556 | ||
557 | function pthread_setspecific | |
558 | (key : pthread_key_t; | |
559 | value : System.Address) return int; | |
560 | pragma Import (C, pthread_setspecific, "PTHREAD_SETSPECIFIC"); | |
561 | ||
562 | function pthread_getspecific (key : pthread_key_t) return System.Address; | |
563 | pragma Import (C, pthread_getspecific, "PTHREAD_GETSPECIFIC"); | |
564 | ||
565 | type destructor_pointer is access procedure (arg : System.Address); | |
566 | ||
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"); | |
571 | ||
572 | private | |
573 | ||
574 | type pid_t is new int; | |
575 | ||
576 | type pthreadLongAddr_p is mod 2 ** Long_Integer'Size; | |
577 | ||
578 | type pthreadLongAddr_t is mod 2 ** Long_Integer'Size; | |
579 | type pthreadLongAddr_t_ptr is mod 2 ** Long_Integer'Size; | |
580 | ||
581 | type pthreadLongString_t is mod 2 ** Long_Integer'Size; | |
582 | ||
583 | type pthreadLongUint_t is mod 2 ** Long_Integer'Size; | |
584 | type pthreadLongUint_array is array (Natural range <>) | |
585 | of pthreadLongUint_t; | |
586 | ||
587 | type pthread_t is mod 2 ** Long_Integer'Size; | |
588 | ||
589 | type pthread_cond_t is record | |
590 | state : unsigned; | |
591 | valid : unsigned; | |
592 | name : pthreadLongString_t; | |
593 | arg : unsigned; | |
594 | sequence : unsigned; | |
595 | block : pthreadLongAddr_t_ptr; | |
596 | end record; | |
597 | for pthread_cond_t'Size use 8*32; | |
598 | pragma Convention (C, pthread_cond_t); | |
599 | ||
600 | type pthread_attr_t is record | |
601 | valid : long; | |
602 | name : pthreadLongString_t; | |
603 | arg : pthreadLongUint_t; | |
604 | reserved : pthreadLongUint_array (0 .. 18); | |
605 | end record; | |
606 | for pthread_attr_t'Size use 8*176; | |
607 | pragma Convention (C, pthread_attr_t); | |
608 | ||
609 | type pthread_mutex_t is record | |
610 | lock : unsigned; | |
611 | valid : unsigned; | |
612 | name : pthreadLongString_t; | |
613 | arg : unsigned; | |
614 | sequence : unsigned; | |
615 | block : pthreadLongAddr_p; | |
616 | owner : unsigned; | |
617 | depth : unsigned; | |
618 | end record; | |
619 | for pthread_mutex_t'Size use 8*40; | |
620 | pragma Convention (C, pthread_mutex_t); | |
621 | ||
622 | type pthread_mutexattr_t is record | |
623 | valid : long; | |
624 | reserved : pthreadLongUint_array (0 .. 14); | |
625 | end record; | |
626 | for pthread_mutexattr_t'Size use 8*128; | |
627 | pragma Convention (C, pthread_mutexattr_t); | |
628 | ||
629 | type pthread_condattr_t is record | |
630 | valid : long; | |
631 | reserved : pthreadLongUint_array (0 .. 12); | |
632 | end record; | |
633 | for pthread_condattr_t'Size use 8*112; | |
634 | pragma Convention (C, pthread_condattr_t); | |
635 | ||
636 | type pthread_key_t is new unsigned; | |
637 | ||
3670c51d | 638 | pragma Inline (pthread_self); |
639 | ||
e6e7bf38 | 640 | end System.OS_Interface; |