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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [s-osinte-hpux-dce.adb] - 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
--                                  B o d y                                 --
8
--                                                                          --
9
--             Copyright (C) 1991-1994, Florida State University            --
10
--                     Copyright (C) 1995-2010, AdaCore                     --
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 DCE version of this package.
34
--  Currently HP-UX and SNI use this file
35
 
36
pragma Polling (Off);
37
--  Turn off polling, we do not want ATC polling to take place during
38
--  tasking operations. It causes infinite loops and other problems.
39
 
40
--  This package encapsulates all direct interfaces to OS services
41
--  that are needed by children of System.
42
 
43
with Interfaces.C; use Interfaces.C;
44
 
45
package body System.OS_Interface is
46
 
47
   -----------------
48
   -- To_Duration --
49
   -----------------
50
 
51
   function To_Duration (TS : timespec) return Duration is
52
   begin
53
      return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
54
   end To_Duration;
55
 
56
   -----------------
57
   -- To_Timespec --
58
   -----------------
59
 
60
   function To_Timespec (D : Duration) return timespec is
61
      S : time_t;
62
      F : Duration;
63
 
64
   begin
65
      S := time_t (Long_Long_Integer (D));
66
      F := D - Duration (S);
67
 
68
      --  If F has negative value due to a round-up, adjust for positive F
69
      --  value.
70
      if F < 0.0 then
71
         S := S - 1;
72
         F := F + 1.0;
73
      end if;
74
 
75
      return timespec'(tv_sec => S,
76
                       tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
77
   end To_Timespec;
78
 
79
   -------------------------
80
   -- POSIX.1c  Section 3 --
81
   -------------------------
82
 
83
   function sigwait
84
     (set : access sigset_t;
85
      sig : access Signal) return int
86
   is
87
      Result : int;
88
 
89
   begin
90
      Result := sigwait (set);
91
 
92
      if Result = -1 then
93
         sig.all := 0;
94
         return errno;
95
      end if;
96
 
97
      sig.all := Signal (Result);
98
      return 0;
99
   end sigwait;
100
 
101
   --  DCE_THREADS does not have pthread_kill. Instead, we just ignore it
102
 
103
   function pthread_kill (thread : pthread_t; sig : Signal) return int is
104
      pragma Unreferenced (thread, sig);
105
   begin
106
      return 0;
107
   end pthread_kill;
108
 
109
   --------------------------
110
   -- POSIX.1c  Section 11 --
111
   --------------------------
112
 
113
   --  For all following functions, DCE Threads has a non standard behavior.
114
   --  It sets errno but the standard Posix requires it to be returned.
115
 
116
   function pthread_mutexattr_init
117
     (attr : access pthread_mutexattr_t) return int
118
   is
119
      function pthread_mutexattr_create
120
        (attr : access pthread_mutexattr_t) return int;
121
      pragma Import (C, pthread_mutexattr_create, "pthread_mutexattr_create");
122
 
123
   begin
124
      if pthread_mutexattr_create (attr) /= 0 then
125
         return errno;
126
      else
127
         return 0;
128
      end if;
129
   end pthread_mutexattr_init;
130
 
131
   function pthread_mutexattr_destroy
132
     (attr : access pthread_mutexattr_t) return int
133
   is
134
      function pthread_mutexattr_delete
135
        (attr : access pthread_mutexattr_t) return int;
136
      pragma Import (C, pthread_mutexattr_delete, "pthread_mutexattr_delete");
137
 
138
   begin
139
      if pthread_mutexattr_delete (attr) /= 0 then
140
         return errno;
141
      else
142
         return 0;
143
      end if;
144
   end pthread_mutexattr_destroy;
145
 
146
   function pthread_mutex_init
147
     (mutex : access pthread_mutex_t;
148
      attr  : access pthread_mutexattr_t) return int
149
   is
150
      function pthread_mutex_init_base
151
        (mutex : access pthread_mutex_t;
152
         attr  : pthread_mutexattr_t) return int;
153
      pragma Import (C, pthread_mutex_init_base, "pthread_mutex_init");
154
 
155
   begin
156
      if pthread_mutex_init_base (mutex, attr.all) /= 0 then
157
         return errno;
158
      else
159
         return 0;
160
      end if;
161
   end pthread_mutex_init;
162
 
163
   function pthread_mutex_destroy
164
     (mutex : access pthread_mutex_t) return int
165
   is
166
      function pthread_mutex_destroy_base
167
        (mutex : access pthread_mutex_t) return int;
168
      pragma Import (C, pthread_mutex_destroy_base, "pthread_mutex_destroy");
169
 
170
   begin
171
      if pthread_mutex_destroy_base (mutex) /= 0 then
172
         return errno;
173
      else
174
         return 0;
175
      end if;
176
   end pthread_mutex_destroy;
177
 
178
   function pthread_mutex_lock
179
     (mutex : access pthread_mutex_t) return int
180
   is
181
      function pthread_mutex_lock_base
182
        (mutex : access pthread_mutex_t) return int;
183
      pragma Import (C, pthread_mutex_lock_base, "pthread_mutex_lock");
184
 
185
   begin
186
      if pthread_mutex_lock_base (mutex) /= 0 then
187
         return errno;
188
      else
189
         return 0;
190
      end if;
191
   end pthread_mutex_lock;
192
 
193
   function pthread_mutex_unlock
194
     (mutex : access pthread_mutex_t) return int
195
   is
196
      function pthread_mutex_unlock_base
197
        (mutex : access pthread_mutex_t) return int;
198
      pragma Import (C, pthread_mutex_unlock_base, "pthread_mutex_unlock");
199
 
200
   begin
201
      if pthread_mutex_unlock_base (mutex) /= 0 then
202
         return errno;
203
      else
204
         return 0;
205
      end if;
206
   end pthread_mutex_unlock;
207
 
208
   function pthread_condattr_init
209
     (attr : access pthread_condattr_t) return int
210
   is
211
      function pthread_condattr_create
212
        (attr : access pthread_condattr_t) return int;
213
      pragma Import (C, pthread_condattr_create, "pthread_condattr_create");
214
 
215
   begin
216
      if pthread_condattr_create (attr) /= 0 then
217
         return errno;
218
      else
219
         return 0;
220
      end if;
221
   end pthread_condattr_init;
222
 
223
   function pthread_condattr_destroy
224
     (attr : access pthread_condattr_t) return int
225
   is
226
      function pthread_condattr_delete
227
        (attr : access pthread_condattr_t) return int;
228
      pragma Import (C, pthread_condattr_delete, "pthread_condattr_delete");
229
 
230
   begin
231
      if pthread_condattr_delete (attr) /= 0 then
232
         return errno;
233
      else
234
         return 0;
235
      end if;
236
   end pthread_condattr_destroy;
237
 
238
   function pthread_cond_init
239
     (cond : access pthread_cond_t;
240
      attr : access pthread_condattr_t) return int
241
   is
242
      function pthread_cond_init_base
243
        (cond : access pthread_cond_t;
244
         attr : pthread_condattr_t) return int;
245
      pragma Import (C, pthread_cond_init_base, "pthread_cond_init");
246
 
247
   begin
248
      if pthread_cond_init_base (cond, attr.all) /= 0 then
249
         return errno;
250
      else
251
         return 0;
252
      end if;
253
   end pthread_cond_init;
254
 
255
   function pthread_cond_destroy
256
     (cond : access pthread_cond_t) return int
257
   is
258
      function pthread_cond_destroy_base
259
        (cond : access pthread_cond_t) return int;
260
      pragma Import (C, pthread_cond_destroy_base, "pthread_cond_destroy");
261
 
262
   begin
263
      if pthread_cond_destroy_base (cond) /= 0 then
264
         return errno;
265
      else
266
         return 0;
267
      end if;
268
   end pthread_cond_destroy;
269
 
270
   function pthread_cond_signal
271
     (cond : access pthread_cond_t) return int
272
   is
273
      function pthread_cond_signal_base
274
        (cond : access pthread_cond_t) return int;
275
      pragma Import (C, pthread_cond_signal_base, "pthread_cond_signal");
276
 
277
   begin
278
      if pthread_cond_signal_base (cond) /= 0 then
279
         return errno;
280
      else
281
         return 0;
282
      end if;
283
   end pthread_cond_signal;
284
 
285
   function pthread_cond_wait
286
     (cond  : access pthread_cond_t;
287
      mutex : access pthread_mutex_t) return int
288
   is
289
      function pthread_cond_wait_base
290
        (cond  : access pthread_cond_t;
291
         mutex : access pthread_mutex_t) return int;
292
      pragma Import (C, pthread_cond_wait_base, "pthread_cond_wait");
293
 
294
   begin
295
      if pthread_cond_wait_base (cond, mutex) /= 0 then
296
         return errno;
297
      else
298
         return 0;
299
      end if;
300
   end pthread_cond_wait;
301
 
302
   function pthread_cond_timedwait
303
     (cond    : access pthread_cond_t;
304
      mutex   : access pthread_mutex_t;
305
      abstime : access timespec) return int
306
   is
307
      function pthread_cond_timedwait_base
308
        (cond    : access pthread_cond_t;
309
         mutex   : access pthread_mutex_t;
310
         abstime : access timespec) return int;
311
      pragma Import (C, pthread_cond_timedwait_base, "pthread_cond_timedwait");
312
 
313
   begin
314
      if pthread_cond_timedwait_base (cond, mutex, abstime) /= 0 then
315
         return (if errno = EAGAIN then ETIMEDOUT else errno);
316
      else
317
         return 0;
318
      end if;
319
   end pthread_cond_timedwait;
320
 
321
   ----------------------------
322
   --  POSIX.1c  Section 13  --
323
   ----------------------------
324
 
325
   function pthread_setschedparam
326
     (thread : pthread_t;
327
      policy : int;
328
      param  : access struct_sched_param) return int
329
   is
330
      function pthread_setscheduler
331
        (thread   : pthread_t;
332
         policy   : int;
333
         priority : int) return int;
334
      pragma Import (C, pthread_setscheduler, "pthread_setscheduler");
335
 
336
   begin
337
      if pthread_setscheduler (thread, policy, param.sched_priority) = -1 then
338
         return errno;
339
      else
340
         return 0;
341
      end if;
342
   end pthread_setschedparam;
343
 
344
   function sched_yield return int is
345
      procedure pthread_yield;
346
      pragma Import (C, pthread_yield, "pthread_yield");
347
   begin
348
      pthread_yield;
349
      return 0;
350
   end sched_yield;
351
 
352
   -----------------------------
353
   --  P1003.1c - Section 16  --
354
   -----------------------------
355
 
356
   function pthread_attr_init
357
     (attributes : access pthread_attr_t) return int
358
   is
359
      function pthread_attr_create
360
        (attributes : access pthread_attr_t) return int;
361
      pragma Import (C, pthread_attr_create, "pthread_attr_create");
362
 
363
   begin
364
      if pthread_attr_create (attributes) /= 0 then
365
         return errno;
366
      else
367
         return 0;
368
      end if;
369
   end pthread_attr_init;
370
 
371
   function pthread_attr_destroy
372
     (attributes : access pthread_attr_t) return int
373
   is
374
      function pthread_attr_delete
375
        (attributes : access pthread_attr_t) return int;
376
      pragma Import (C, pthread_attr_delete, "pthread_attr_delete");
377
 
378
   begin
379
      if pthread_attr_delete (attributes) /= 0 then
380
         return errno;
381
      else
382
         return 0;
383
      end if;
384
   end pthread_attr_destroy;
385
 
386
   function pthread_attr_setstacksize
387
     (attr      : access pthread_attr_t;
388
      stacksize : size_t) return int
389
   is
390
      function pthread_attr_setstacksize_base
391
        (attr      : access pthread_attr_t;
392
         stacksize : size_t) return int;
393
      pragma Import (C, pthread_attr_setstacksize_base,
394
                     "pthread_attr_setstacksize");
395
 
396
   begin
397
      if pthread_attr_setstacksize_base (attr, stacksize) /= 0 then
398
         return errno;
399
      else
400
         return 0;
401
      end if;
402
   end pthread_attr_setstacksize;
403
 
404
   function pthread_create
405
     (thread        : access pthread_t;
406
      attributes    : access pthread_attr_t;
407
      start_routine : Thread_Body;
408
      arg           : System.Address) return int
409
   is
410
      function pthread_create_base
411
        (thread        : access pthread_t;
412
         attributes    : pthread_attr_t;
413
         start_routine : Thread_Body;
414
         arg           : System.Address) return int;
415
      pragma Import (C, pthread_create_base, "pthread_create");
416
 
417
   begin
418
      if pthread_create_base
419
        (thread, attributes.all, start_routine, arg) /= 0
420
      then
421
         return errno;
422
      else
423
         return 0;
424
      end if;
425
   end pthread_create;
426
 
427
   --------------------------
428
   -- POSIX.1c  Section 17 --
429
   --------------------------
430
 
431
   function pthread_setspecific
432
     (key   : pthread_key_t;
433
      value : System.Address) return int
434
   is
435
      function pthread_setspecific_base
436
        (key   : pthread_key_t;
437
         value : System.Address) return int;
438
      pragma Import (C, pthread_setspecific_base, "pthread_setspecific");
439
 
440
   begin
441
      if pthread_setspecific_base (key, value) /= 0 then
442
         return errno;
443
      else
444
         return 0;
445
      end if;
446
   end pthread_setspecific;
447
 
448
   function pthread_getspecific (key : pthread_key_t) return System.Address is
449
      function pthread_getspecific_base
450
        (key   : pthread_key_t;
451
         value : access System.Address) return  int;
452
      pragma Import (C, pthread_getspecific_base, "pthread_getspecific");
453
      Addr : aliased System.Address;
454
 
455
   begin
456
      if pthread_getspecific_base (key, Addr'Access) /= 0 then
457
         return System.Null_Address;
458
      else
459
         return Addr;
460
      end if;
461
   end pthread_getspecific;
462
 
463
   function pthread_key_create
464
     (key        : access pthread_key_t;
465
      destructor : destructor_pointer) return int
466
   is
467
      function pthread_keycreate
468
        (key        : access pthread_key_t;
469
         destructor : destructor_pointer) return int;
470
      pragma Import (C, pthread_keycreate, "pthread_keycreate");
471
 
472
   begin
473
      if pthread_keycreate (key, destructor) /= 0 then
474
         return errno;
475
      else
476
         return 0;
477
      end if;
478
   end pthread_key_create;
479
 
480
   function Get_Stack_Base (thread : pthread_t) return Address is
481
      pragma Warnings (Off, thread);
482
   begin
483
      return Null_Address;
484
   end Get_Stack_Base;
485
 
486
   procedure pthread_init is
487
   begin
488
      null;
489
   end pthread_init;
490
 
491
   function intr_attach (sig : int; handler : isr_address) return long is
492
      function c_signal (sig : int; handler : isr_address) return long;
493
      pragma Import (C, c_signal, "signal");
494
   begin
495
      return c_signal (sig, handler);
496
   end intr_attach;
497
 
498
end System.OS_Interface;

powered by: WebSVN 2.1.0

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