OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [s-osinte-vms.ads] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                 GNAT 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
--                                                                          --
9
--             Copyright (C) 1991-1994, Florida State University            --
10
--          Copyright (C) 1995-2010, Free Software Foundation, Inc.         --
11
--                                                                          --
12
-- GNAT 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 3,  or (at your option) any later ver- --
15
-- sion.  GNAT 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.                                     --
18
--                                                                          --
19
-- As a special exception under Section 7 of GPL version 3, you are granted --
20
-- additional permissions described in the GCC Runtime Library Exception,   --
21
-- version 3.1, as published by the Free Software Foundation.               --
22
--                                                                          --
23
-- You should have received a copy of the GNU General Public License and    --
24
-- a copy of the GCC Runtime Library Exception along with this program;     --
25
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
26
-- <http://www.gnu.org/licenses/>.                                          --
27
--                                                                          --
28
-- GNARL was developed by the GNARL team at Florida State University.       --
29
-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
30
--                                                                          --
31
------------------------------------------------------------------------------
32
 
33
--  This is a OpenVMS/Alpha version of this package
34
 
35
--  This package encapsulates all direct interfaces to OS services
36
--  that are needed by the tasking run-time (libgnarl).
37
 
38
--  PLEASE DO NOT add any with-clauses to this package or remove the pragma
39
--  Preelaborate. This package is designed to be a bottom-level (leaf) package.
40
 
41
with Interfaces.C;
42
 
43
with Ada.Unchecked_Conversion;
44
 
45
with System.Aux_DEC;
46
 
47
package System.OS_Interface is
48
   pragma Preelaborate;
49
 
50
   pragma Linker_Options ("--for-linker=sys$library:pthread$rtl.exe");
51
   --  Link in the DEC threads library
52
 
53
   --  pragma Linker_Options ("--for-linker=/threads_enable");
54
   --  Enable upcalls and multiple kernel threads.
55
 
56
   subtype int            is Interfaces.C.int;
57
   subtype short          is Interfaces.C.short;
58
   subtype long           is Interfaces.C.long;
59
   subtype unsigned       is Interfaces.C.unsigned;
60
   subtype unsigned_short is Interfaces.C.unsigned_short;
61
   subtype unsigned_long  is Interfaces.C.unsigned_long;
62
   subtype unsigned_char  is Interfaces.C.unsigned_char;
63
   subtype plain_char     is Interfaces.C.plain_char;
64
   subtype size_t         is Interfaces.C.size_t;
65
 
66
   -----------------------------
67
   -- Signals (Interrupt IDs) --
68
   -----------------------------
69
 
70
   --  Type signal has an arbitrary limit of 31
71
 
72
   Max_Interrupt : constant := 31;
73
   type Signal is new unsigned range 0 .. Max_Interrupt;
74
   for Signal'Size use unsigned'Size;
75
 
76
   type sigset_t is array (Signal) of Boolean;
77
   pragma Pack (sigset_t);
78
 
79
   --  Interrupt_Number_Type
80
   --  Unsigned long integer denoting the number of an interrupt
81
 
82
   subtype Interrupt_Number_Type is unsigned_long;
83
 
84
   --  OpenVMS system services return values of type Cond_Value_Type
85
 
86
   subtype Cond_Value_Type is unsigned_long;
87
   subtype Short_Cond_Value_Type is unsigned_short;
88
 
89
   type IO_Status_Block_Type is record
90
      Status   : Short_Cond_Value_Type;
91
      Count    : unsigned_short;
92
      Dev_Info : unsigned_long;
93
   end record;
94
 
95
   type AST_Handler is access procedure (Param : Address);
96
   pragma Convention (C, AST_Handler);
97
   No_AST_Handler : constant AST_Handler := null;
98
 
99
   CMB_M_READONLY  : constant := 16#00000001#;
100
   CMB_M_WRITEONLY : constant := 16#00000002#;
101
   AGN_M_READONLY  : constant := 16#00000001#;
102
   AGN_M_WRITEONLY : constant := 16#00000002#;
103
 
104
   IO_WRITEVBLK : constant := 48;  --  WRITE VIRTUAL BLOCK
105
   IO_READVBLK  : constant := 49;  --  READ VIRTUAL BLOCK
106
 
107
   ----------------
108
   -- Sys_Assign --
109
   ----------------
110
   --
111
   --  Assign I/O Channel
112
   --
113
   --  Status = returned status
114
   --  Devnam = address  of  device  name  or  logical  name   string
115
   --               descriptor
116
   --  Chan   = address of word to receive channel number assigned
117
   --  Acmode = access mode associated with channel
118
   --  Mbxnam = address of mailbox logical name string descriptor, if
119
   --               mailbox associated with device
120
   --  Flags  = optional channel flags longword for specifying options
121
   --           for the $ASSIGN operation
122
   --
123
 
124
   procedure Sys_Assign
125
     (Status : out Cond_Value_Type;
126
      Devnam : String;
127
      Chan   : out unsigned_short;
128
      Acmode : unsigned_short := 0;
129
      Mbxnam : String := String'Null_Parameter;
130
      Flags  : unsigned_long := 0);
131
   pragma Interface (External, Sys_Assign);
132
   pragma Import_Valued_Procedure
133
     (Sys_Assign, "SYS$ASSIGN",
134
      (Cond_Value_Type, String,         unsigned_short,
135
       unsigned_short,  String,         unsigned_long),
136
      (Value,           Descriptor (s), Reference,
137
       Value,           Descriptor (s), Value),
138
      Flags);
139
 
140
   ----------------
141
   -- Sys_Cantim --
142
   ----------------
143
   --
144
   --  Cancel Timer
145
   --
146
   --  Status  = returned status
147
   --  Reqidt  = ID of timer to be cancelled
148
   --  Acmode  = Access mode
149
   --
150
   procedure Sys_Cantim
151
     (Status : out Cond_Value_Type;
152
      Reqidt : Address;
153
      Acmode : unsigned);
154
   pragma Interface (External, Sys_Cantim);
155
   pragma Import_Valued_Procedure
156
     (Sys_Cantim, "SYS$CANTIM",
157
      (Cond_Value_Type, Address, unsigned),
158
      (Value,           Value,   Value));
159
 
160
   ----------------
161
   -- Sys_Crembx --
162
   ----------------
163
   --
164
   --  Create mailbox
165
   --
166
   --     Status  = returned status
167
   --     Prmflg  = permanent flag
168
   --     Chan    = channel
169
   --     Maxmsg  = maximum message
170
   --     Bufquo  = buufer quote
171
   --     Promsk  = protection mast
172
   --     Acmode  = access mode
173
   --     Lognam  = logical name
174
   --     Flags   = flags
175
   --
176
   procedure Sys_Crembx
177
     (Status : out Cond_Value_Type;
178
      Prmflg : unsigned_char;
179
      Chan   : out unsigned_short;
180
      Maxmsg : unsigned_long := 0;
181
      Bufquo : unsigned_long := 0;
182
      Promsk : unsigned_short := 0;
183
      Acmode : unsigned_short := 0;
184
      Lognam : String;
185
      Flags  : unsigned_long := 0);
186
   pragma Interface (External, Sys_Crembx);
187
   pragma Import_Valued_Procedure
188
     (Sys_Crembx, "SYS$CREMBX",
189
      (Cond_Value_Type, unsigned_char,  unsigned_short,
190
       unsigned_long,   unsigned_long,  unsigned_short,
191
       unsigned_short,  String,         unsigned_long),
192
      (Value,           Value,          Reference,
193
       Value,           Value,          Value,
194
       Value,           Descriptor (s), Value));
195
 
196
   -------------
197
   -- Sys_QIO --
198
   -------------
199
   --
200
   --    Queue I/O
201
   --
202
   --     Status = Returned status of call
203
   --     EFN    = event flag to be set when I/O completes
204
   --     Chan   = channel
205
   --     Func   = function
206
   --     Iosb   = I/O status block
207
   --     Astadr = system trap to be generated when I/O completes
208
   --     Astprm = AST parameter
209
   --     P1-6   = optional parameters
210
 
211
   procedure Sys_QIO
212
     (Status : out Cond_Value_Type;
213
      EFN    : unsigned_long := 0;
214
      Chan   : unsigned_short;
215
      Func   : unsigned_long := 0;
216
      Iosb   : out IO_Status_Block_Type;
217
      Astadr : AST_Handler := No_AST_Handler;
218
      Astprm : Address := Null_Address;
219
      P1     : unsigned_long := 0;
220
      P2     : unsigned_long := 0;
221
      P3     : unsigned_long := 0;
222
      P4     : unsigned_long := 0;
223
      P5     : unsigned_long := 0;
224
      P6     : unsigned_long := 0);
225
 
226
   procedure Sys_QIO
227
     (Status : out Cond_Value_Type;
228
      EFN    : unsigned_long := 0;
229
      Chan   : unsigned_short;
230
      Func   : unsigned_long := 0;
231
      Iosb   : Address := Null_Address;
232
      Astadr : AST_Handler := No_AST_Handler;
233
      Astprm : Address := Null_Address;
234
      P1     : unsigned_long := 0;
235
      P2     : unsigned_long := 0;
236
      P3     : unsigned_long := 0;
237
      P4     : unsigned_long := 0;
238
      P5     : unsigned_long := 0;
239
      P6     : unsigned_long := 0);
240
 
241
   pragma Interface (External, Sys_QIO);
242
   pragma Import_Valued_Procedure
243
     (Sys_QIO, "SYS$QIO",
244
      (Cond_Value_Type,      unsigned_long, unsigned_short, unsigned_long,
245
       IO_Status_Block_Type, AST_Handler,   Address,
246
       unsigned_long,        unsigned_long, unsigned_long,
247
       unsigned_long,        unsigned_long, unsigned_long),
248
      (Value,                Value,         Value,          Value,
249
       Reference,            Value,         Value,
250
       Value,                Value,         Value,
251
       Value,                Value,         Value));
252
 
253
   pragma Import_Valued_Procedure
254
     (Sys_QIO, "SYS$QIO",
255
      (Cond_Value_Type, unsigned_long, unsigned_short, unsigned_long,
256
       Address,         AST_Handler,   Address,
257
       unsigned_long,   unsigned_long, unsigned_long,
258
       unsigned_long,   unsigned_long, unsigned_long),
259
      (Value,           Value,         Value,          Value,
260
       Value,           Value,         Value,
261
       Value,           Value,         Value,
262
       Value,           Value,         Value));
263
 
264
   ----------------
265
   -- Sys_Setimr --
266
   ----------------
267
   --
268
   --    Set Timer
269
   --
270
   --     Status = Returned status of call
271
   --     EFN    = event flag to be set when timer expires
272
   --     Tim    = expiration time
273
   --     AST    = system trap to be generated when timer expires
274
   --     Redidt = returned ID of timer (e.g. to cancel timer)
275
   --     Flags  = flags
276
   --
277
   procedure Sys_Setimr
278
     (Status : out Cond_Value_Type;
279
      EFN    : unsigned_long;
280
      Tim    : Long_Integer;
281
      AST    : AST_Handler;
282
      Reqidt : Address;
283
      Flags  : unsigned_long);
284
   pragma Interface (External, Sys_Setimr);
285
   pragma Import_Valued_Procedure
286
     (Sys_Setimr, "SYS$SETIMR",
287
      (Cond_Value_Type, unsigned_long,     Long_Integer,
288
       AST_Handler,     Address,           unsigned_long),
289
      (Value,           Value,             Reference,
290
       Value,           Value,             Value));
291
 
292
   Interrupt_ID_0   : constant  := 0;
293
   Interrupt_ID_1   : constant  := 1;
294
   Interrupt_ID_2   : constant  := 2;
295
   Interrupt_ID_3   : constant  := 3;
296
   Interrupt_ID_4   : constant  := 4;
297
   Interrupt_ID_5   : constant  := 5;
298
   Interrupt_ID_6   : constant  := 6;
299
   Interrupt_ID_7   : constant  := 7;
300
   Interrupt_ID_8   : constant  := 8;
301
   Interrupt_ID_9   : constant  := 9;
302
   Interrupt_ID_10  : constant  := 10;
303
   Interrupt_ID_11  : constant  := 11;
304
   Interrupt_ID_12  : constant  := 12;
305
   Interrupt_ID_13  : constant  := 13;
306
   Interrupt_ID_14  : constant  := 14;
307
   Interrupt_ID_15  : constant  := 15;
308
   Interrupt_ID_16  : constant  := 16;
309
   Interrupt_ID_17  : constant  := 17;
310
   Interrupt_ID_18  : constant  := 18;
311
   Interrupt_ID_19  : constant  := 19;
312
   Interrupt_ID_20  : constant  := 20;
313
   Interrupt_ID_21  : constant  := 21;
314
   Interrupt_ID_22  : constant  := 22;
315
   Interrupt_ID_23  : constant  := 23;
316
   Interrupt_ID_24  : constant  := 24;
317
   Interrupt_ID_25  : constant  := 25;
318
   Interrupt_ID_26  : constant  := 26;
319
   Interrupt_ID_27  : constant  := 27;
320
   Interrupt_ID_28  : constant  := 28;
321
   Interrupt_ID_29  : constant  := 29;
322
   Interrupt_ID_30  : constant  := 30;
323
   Interrupt_ID_31  : constant  := 31;
324
 
325
   -----------
326
   -- Errno --
327
   -----------
328
 
329
   function errno return int;
330
   pragma Import (C, errno, "__get_errno");
331
 
332
   EINTR  : constant := 4;   --  Interrupted system call
333
   EAGAIN : constant := 11;  --  No more processes
334
   ENOMEM : constant := 12;  --  Not enough core
335
 
336
   -------------------------
337
   -- Priority Scheduling --
338
   -------------------------
339
 
340
   SCHED_FIFO  : constant := 1;
341
   SCHED_RR    : constant := 2;
342
   SCHED_OTHER : constant := 3;
343
   SCHED_BG    : constant := 4;
344
   SCHED_LFI   : constant := 5;
345
   SCHED_LRR   : constant := 6;
346
 
347
   -------------
348
   -- Process --
349
   -------------
350
 
351
   type pid_t is private;
352
 
353
   function kill (pid : pid_t; sig : Signal) return int;
354
   pragma Import (C, kill);
355
 
356
   function getpid return pid_t;
357
   pragma Import (C, getpid);
358
 
359
   -------------
360
   -- Threads --
361
   -------------
362
 
363
   type Thread_Body is access
364
     function (arg : System.Address) return System.Address;
365
   pragma Convention (C, Thread_Body);
366
 
367
   function Thread_Body_Access is new
368
     Ada.Unchecked_Conversion (System.Aux_DEC.Short_Address, Thread_Body);
369
 
370
   type pthread_t           is private;
371
   subtype Thread_Id        is pthread_t;
372
 
373
   type pthread_mutex_t     is limited private;
374
   type pthread_cond_t      is limited private;
375
   type pthread_attr_t      is limited private;
376
   type pthread_mutexattr_t is limited private;
377
   type pthread_condattr_t  is limited private;
378
   type pthread_key_t       is private;
379
 
380
   PTHREAD_CREATE_JOINABLE     : constant := 0;
381
   PTHREAD_CREATE_DETACHED     : constant := 1;
382
 
383
   PTHREAD_CANCEL_DISABLE      : constant := 0;
384
   PTHREAD_CANCEL_ENABLE       : constant := 1;
385
 
386
   PTHREAD_CANCEL_DEFERRED     : constant := 0;
387
   PTHREAD_CANCEL_ASYNCHRONOUS : constant := 1;
388
 
389
   --  Don't use ERRORCHECK mutexes, they don't work when a thread is not
390
   --  the owner.  AST's, at least, unlock others threads mutexes. Even
391
   --  if the error is ignored, they don't work.
392
   PTHREAD_MUTEX_NORMAL_NP     : constant := 0;
393
   PTHREAD_MUTEX_RECURSIVE_NP  : constant := 1;
394
   PTHREAD_MUTEX_ERRORCHECK_NP : constant := 2;
395
 
396
   PTHREAD_INHERIT_SCHED       : constant := 0;
397
   PTHREAD_EXPLICIT_SCHED      : constant := 1;
398
 
399
   function pthread_cancel (thread : pthread_t) return int;
400
   pragma Import (C, pthread_cancel, "PTHREAD_CANCEL");
401
 
402
   procedure pthread_testcancel;
403
   pragma Import (C, pthread_testcancel, "PTHREAD_TESTCANCEL");
404
 
405
   function pthread_setcancelstate
406
     (newstate : int; oldstate : access int) return int;
407
   pragma Import (C, pthread_setcancelstate, "PTHREAD_SETCANCELSTATE");
408
 
409
   function pthread_setcanceltype
410
     (newtype : int; oldtype : access int) return int;
411
   pragma Import (C, pthread_setcanceltype, "PTHREAD_SETCANCELTYPE");
412
 
413
   -------------------------
414
   -- POSIX.1c  Section 3 --
415
   -------------------------
416
 
417
   function pthread_lock_global_np return int;
418
   pragma Import (C, pthread_lock_global_np, "PTHREAD_LOCK_GLOBAL_NP");
419
 
420
   function pthread_unlock_global_np return int;
421
   pragma Import (C, pthread_unlock_global_np, "PTHREAD_UNLOCK_GLOBAL_NP");
422
 
423
   --------------------------
424
   -- POSIX.1c  Section 11 --
425
   --------------------------
426
 
427
   function pthread_mutexattr_init
428
     (attr : access pthread_mutexattr_t) return int;
429
   pragma Import (C, pthread_mutexattr_init, "PTHREAD_MUTEXATTR_INIT");
430
 
431
   function pthread_mutexattr_destroy
432
     (attr : access pthread_mutexattr_t) return int;
433
   pragma Import (C, pthread_mutexattr_destroy, "PTHREAD_MUTEXATTR_DESTROY");
434
 
435
   function pthread_mutexattr_settype_np
436
     (attr      : access pthread_mutexattr_t;
437
      mutextype : int) return int;
438
   pragma Import (C, pthread_mutexattr_settype_np,
439
                     "PTHREAD_MUTEXATTR_SETTYPE_NP");
440
 
441
   function pthread_mutex_init
442
     (mutex : access pthread_mutex_t;
443
      attr  : access pthread_mutexattr_t) return int;
444
   pragma Import (C, pthread_mutex_init, "PTHREAD_MUTEX_INIT");
445
 
446
   function pthread_mutex_destroy (mutex : access pthread_mutex_t) return int;
447
   pragma Import (C, pthread_mutex_destroy, "PTHREAD_MUTEX_DESTROY");
448
 
449
   function pthread_mutex_lock (mutex : access pthread_mutex_t) return int;
450
   pragma Import (C, pthread_mutex_lock, "PTHREAD_MUTEX_LOCK");
451
 
452
   function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int;
453
   pragma Import (C, pthread_mutex_unlock, "PTHREAD_MUTEX_UNLOCK");
454
 
455
   function pthread_condattr_init
456
     (attr : access pthread_condattr_t) return int;
457
   pragma Import (C, pthread_condattr_init, "PTHREAD_CONDATTR_INIT");
458
 
459
   function pthread_condattr_destroy
460
     (attr : access pthread_condattr_t) return int;
461
   pragma Import (C, pthread_condattr_destroy, "PTHREAD_CONDATTR_DESTROY");
462
 
463
   function pthread_cond_init
464
     (cond : access pthread_cond_t;
465
      attr : access pthread_condattr_t) return int;
466
   pragma Import (C, pthread_cond_init, "PTHREAD_COND_INIT");
467
 
468
   function pthread_cond_destroy (cond : access pthread_cond_t) return int;
469
   pragma Import (C, pthread_cond_destroy, "PTHREAD_COND_DESTROY");
470
 
471
   function pthread_cond_signal (cond : access pthread_cond_t) return int;
472
   pragma Import (C, pthread_cond_signal, "PTHREAD_COND_SIGNAL");
473
 
474
   function pthread_cond_signal_int_np
475
     (cond : access pthread_cond_t) return int;
476
   pragma Import (C, pthread_cond_signal_int_np,
477
                  "PTHREAD_COND_SIGNAL_INT_NP");
478
 
479
   function pthread_cond_wait
480
     (cond  : access pthread_cond_t;
481
      mutex : access pthread_mutex_t) return int;
482
   pragma Import (C, pthread_cond_wait, "PTHREAD_COND_WAIT");
483
 
484
   --------------------------
485
   -- POSIX.1c  Section 13 --
486
   --------------------------
487
 
488
   function pthread_mutexattr_setprotocol
489
     (attr : access pthread_mutexattr_t; protocol : int) return int;
490
   pragma Import (C, pthread_mutexattr_setprotocol,
491
                     "PTHREAD_MUTEXATTR_SETPROTOCOL");
492
 
493
   type struct_sched_param is record
494
      sched_priority : int;  --  scheduling priority
495
   end record;
496
   for struct_sched_param'Size use 8*4;
497
   pragma Convention (C, struct_sched_param);
498
 
499
   function pthread_setschedparam
500
     (thread : pthread_t;
501
      policy : int;
502
      param  : access struct_sched_param) return int;
503
   pragma Import (C, pthread_setschedparam, "PTHREAD_SETSCHEDPARAM");
504
 
505
   function pthread_attr_setscope
506
     (attr            : access pthread_attr_t;
507
      contentionscope : int) return int;
508
   pragma Import (C, pthread_attr_setscope, "PTHREAD_ATTR_SETSCOPE");
509
 
510
   function pthread_attr_setinheritsched
511
     (attr            : access pthread_attr_t;
512
      inheritsched : int) return int;
513
   pragma Import (C, pthread_attr_setinheritsched,
514
                     "PTHREAD_ATTR_SETINHERITSCHED");
515
 
516
   function pthread_attr_setschedpolicy
517
     (attr : access pthread_attr_t; policy : int) return int;
518
   pragma Import (C, pthread_attr_setschedpolicy,
519
                     "PTHREAD_ATTR_SETSCHEDPOLICY");
520
 
521
   function pthread_attr_setschedparam
522
     (attr        : access pthread_attr_t;
523
      sched_param : int) return int;
524
   pragma Import (C, pthread_attr_setschedparam, "PTHREAD_ATTR_SETSCHEDPARAM");
525
 
526
   function sched_yield return int;
527
 
528
   --------------------------
529
   -- P1003.1c  Section 16 --
530
   --------------------------
531
 
532
   function pthread_attr_init (attributes : access pthread_attr_t) return int;
533
   pragma Import (C, pthread_attr_init, "PTHREAD_ATTR_INIT");
534
 
535
   function pthread_attr_destroy
536
     (attributes : access pthread_attr_t) return int;
537
   pragma Import (C, pthread_attr_destroy, "PTHREAD_ATTR_DESTROY");
538
 
539
   function pthread_attr_setdetachstate
540
     (attr        : access pthread_attr_t;
541
      detachstate : int) return int;
542
   pragma Import (C, pthread_attr_setdetachstate,
543
                     "PTHREAD_ATTR_SETDETACHSTATE");
544
 
545
   function pthread_attr_setstacksize
546
     (attr      : access pthread_attr_t;
547
      stacksize : size_t) return int;
548
   pragma Import (C, pthread_attr_setstacksize, "PTHREAD_ATTR_SETSTACKSIZE");
549
 
550
   function pthread_create
551
     (thread        : access pthread_t;
552
      attributes    : access pthread_attr_t;
553
      start_routine : Thread_Body;
554
      arg           : System.Address) return int;
555
   pragma Import (C, pthread_create, "PTHREAD_CREATE");
556
 
557
   procedure pthread_exit (status : System.Address);
558
   pragma Import (C, pthread_exit, "PTHREAD_EXIT");
559
 
560
   function pthread_self return pthread_t;
561
 
562
   --------------------------
563
   -- POSIX.1c  Section 17 --
564
   --------------------------
565
 
566
   function pthread_setspecific
567
     (key   : pthread_key_t;
568
      value : System.Address) return  int;
569
   pragma Import (C, pthread_setspecific, "PTHREAD_SETSPECIFIC");
570
 
571
   function pthread_getspecific (key : pthread_key_t) return System.Address;
572
   pragma Import (C, pthread_getspecific, "PTHREAD_GETSPECIFIC");
573
 
574
   type destructor_pointer is access procedure (arg : System.Address);
575
   pragma Convention (C, destructor_pointer);
576
 
577
   function pthread_key_create
578
     (key        : access pthread_key_t;
579
      destructor : destructor_pointer) return int;
580
   pragma Import (C, pthread_key_create, "PTHREAD_KEY_CREATE");
581
 
582
private
583
 
584
   type pid_t is new int;
585
 
586
   type pthreadLongAddr_p is mod 2 ** Long_Integer'Size;
587
 
588
   type pthreadLongAddr_t is mod 2 ** Long_Integer'Size;
589
   type pthreadLongAddr_t_ptr is mod 2 ** Long_Integer'Size;
590
 
591
   type pthreadLongString_t is mod 2 ** Long_Integer'Size;
592
 
593
   type pthreadLongUint_t is mod 2 ** Long_Integer'Size;
594
   type pthreadLongUint_array is array (Natural range <>)
595
     of pthreadLongUint_t;
596
 
597
   type pthread_t is mod 2 ** Long_Integer'Size;
598
 
599
   type pthread_cond_t is record
600
      state    : unsigned;
601
      valid    : unsigned;
602
      name     : pthreadLongString_t;
603
      arg      : unsigned;
604
      sequence : unsigned;
605
      block    : pthreadLongAddr_t_ptr;
606
   end record;
607
   for pthread_cond_t'Size use 8*32;
608
   pragma Convention (C, pthread_cond_t);
609
 
610
   type pthread_attr_t is record
611
      valid    : long;
612
      name     : pthreadLongString_t;
613
      arg      : pthreadLongUint_t;
614
      reserved : pthreadLongUint_array (0 .. 18);
615
   end record;
616
   for pthread_attr_t'Size use 8*176;
617
   pragma Convention (C, pthread_attr_t);
618
 
619
   type pthread_mutex_t is record
620
      lock     : unsigned;
621
      valid    : unsigned;
622
      name     : pthreadLongString_t;
623
      arg      : unsigned;
624
      sequence : unsigned;
625
      block    : pthreadLongAddr_p;
626
      owner    : unsigned;
627
      depth    : unsigned;
628
   end record;
629
   for pthread_mutex_t'Size use 8*40;
630
   pragma Convention (C, pthread_mutex_t);
631
 
632
   type pthread_mutexattr_t is record
633
      valid    : long;
634
      reserved : pthreadLongUint_array (0 .. 14);
635
   end record;
636
   for pthread_mutexattr_t'Size use 8*128;
637
   pragma Convention (C, pthread_mutexattr_t);
638
 
639
   type pthread_condattr_t is record
640
      valid    : long;
641
      reserved : pthreadLongUint_array (0 .. 12);
642
   end record;
643
   for pthread_condattr_t'Size use 8*112;
644
   pragma Convention (C, pthread_condattr_t);
645
 
646
   type pthread_key_t is new unsigned;
647
 
648
   pragma Inline (pthread_self);
649
 
650
end System.OS_Interface;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.