File: posix-implementation.ads

package info (click to toggle)
libflorist 2014-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 1,996 kB
  • ctags: 304
  • sloc: ada: 11,705; ansic: 7,195; makefile: 154; sh: 19
file content (390 lines) | stat: -rw-r--r-- 15,651 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
------------------------------------------------------------------------------
--                                                                          --
--            FLORIST (FSU Implementation of POSIX.5) COMPONENTS            --
--                                                                          --
--                  P O S I X . I M P L E M E N T A T I O N                 --
--                                                                          --
--                                  S p e c                                 --
--                                                                          --
--                                                                          --
--  Copyright (c) 1996-1999 Florida State University (FSU).     All Rights  --
--  Reserved.                                                               --
--                                                                          --
--  This file is a component of FLORIST, an  implementation of an  Ada API  --
--  for the POSIX OS services, for use with  the  GNAT  Ada  compiler  and  --
--  the FSU Gnu Ada Runtime Library (GNARL).   The  interface  is intended  --
--  to be close to that specified in  IEEE STD  1003.5: 1990  and IEEE STD  --
--  1003.5b: 1996.                                                          --
--                                                                          --
--  FLORIST is free software;  you can  redistribute  it and/or  modify it  --
--  under terms of the  GNU  General  Public  License as  published by the  --
--  Free Software Foundation;  either version  2, or (at  your option) any  --
--  later version.  FLORIST is distributed  in  the hope  that  it will be  --
--  useful, but WITHOUT ANY WARRANTY;  without  even the implied  warranty  --
--  of MERCHANTABILITY or FITNESS FOR A PARTICULAR  PURPOSE.  See  the GNU  --
--  General Public License for more details.  You  should have  received a  --
--  copy of the GNU General Public License  distributed  with  GNARL;  see  --
--  file  COPYING.  If not,  write to  the  Free  Software  Foundation, 59  --
--  Temple Place - Suite 330, Boston, MA 02111-1307, USA.                   --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
------------------------------------------------------------------------------
--  [$Revision: 116253 $]

with POSIX.C,
     System.Interrupt_Management,
     Unchecked_Conversion;
package POSIX.Implementation is
   pragma Elaborate_Body;

   --  =========  --
   --   WARNING   --
   --  =========  --

   --  This package should NOT be used directly by an application.
   --  It is internal to the FLORIST implementation of the POSIX.5 API,
   --  and may be changed or replaced in future versions of FLORIST.

   -------------------------
   --  Critical Sections  --
   -------------------------

   --  NEVER raise an exception within a critical section
   --  or abort-deferred section!
   --  Not even indirectly, by calling a subprogram
   --  that might raise an exception.
   --  Always exit the section, then raise the exception.

   --  ALWAYS enclose critical sections in a block with an
   --  exception handler that will call End_Critical_Section
   --  before allowing the exception to propagate, unless you
   --  can prove that no exception will be raised in the code.
   --  (How about Storage_Error, due to stack overflow?)

   --  Try to avoid nesting critical sections,
   --  as it means extra overhead.

   procedure Defer_Abortion;
   procedure Undefer_Abortion;

   --  The following two also defer/undefer abort, as side-effects.

   procedure Begin_Critical_Section;
   procedure End_Critical_Section;

   --------------
   --  Checks  --
   --------------

   --  Don't ever call any of these within a critical section,
   --  or within an abort-deferred section!

   subtype Signal_Mask is System.Interrupt_Management.Interrupt_Mask;
   type Signal_Mask_Access is access all Signal_Mask;

   procedure Raise_POSIX_Error (Error : Error_Code := No_Error);
   pragma No_Return (Raise_POSIX_Error);

   procedure Check (Condition : Boolean;
                    Error : Error_Code;
                    Old_Mask : Signal_Mask_Access := null);

   --  if Condition is false, raise POSIX_Error with
   --  specified error code, else just return
   --
   --  If Old_Mask /= null, then on failure call Restore_Signals with
   --  that mask before raising POSIX_Error.

   procedure Check
     (Result : POSIX.C.int; Old_Mask : Signal_Mask_Access := null);
   function Check
     (Result : POSIX.C.int; Old_Mask : Signal_Mask_Access := null)
     return POSIX.C.int;

   --  if Result is -1 raise POSIX_Error with current error code
   --  otherwise just return Result.
   --
   --  If Old_Mask /= null, then call Restore_Signals with that mask
   --  before raising POSIX_Error.

   procedure Check_NNeg (Result : POSIX.C.int);
   function Check_NNeg (Result : POSIX.C.int) return POSIX.C.int;

   --  same as Check, except any negative value is treated
   --  as a failure
   --  pragma Inline (Check);

   procedure Check_NZ (Result : POSIX.C.int);

   --  same as Check, except any nonzero value is an error code
   --  pragma Inline (Check);

   function Not_Implemented_Neg_One return POSIX.C.int;
   --  return -1 with error code ENOSYS
   pragma Export (C, Not_Implemented_Neg_One, "nosys_neg_one");

   function Not_Implemented_Direct return POSIX.C.int;
   --  return error code ENOSYS
   pragma Export (C, Not_Implemented_Direct, "nosys_direct");

   function Not_Supported_Neg_One return POSIX.C.int;
   --  return -1 with error code ENOTSUP
   pragma Export (C, Not_Supported_Neg_One, "notsup_neg_one");

   function Not_Supported_Direct return POSIX.C.int;
   --  return ENOTSUP
   pragma Export (C, Not_Supported_Direct, "notsup_direct");

   --  These are used as stub link-names for C interface subprograms
   --  which are missing from the OS include-files.

   --  .... We still need to analyze all these functions, one by one,
   --  so that the code in c-posix.c initialized the corresponding ..._LINKNAME
   --  variable to the right value.
   --  If we have any calls to functions that may legitimately return
   --  a value of -1 for a non-error condition, we may need to add some
   --  special stubs for those functions.

   ---------------
   --  Strings  --
   ---------------

   NUL_String : POSIX_String := (1 => NUL);
   function Form_String (Str : POSIX.C.char_ptr) return String;
   function Trim_Leading_Blank (S : String) return String;
   --  pragma Inline (Trim_Leading_Blank);
   procedure Nulterminate
     (To : out POSIX_String;
      From :  String);

   --------------------
   --  String Lists  --
   --------------------

   type POSIX_String_Ptr is access all POSIX_String;

   type PSP_Array is array (Positive range <>) of POSIX_String_Ptr;
   type String_List (Length : Natural) is record
      List : PSP_Array (1 .. Length);
      Char : POSIX.C.char_ptr_array (1 .. Length);
      --  X.Char(i) = X.List(i)(1)'Unchecked_access
   end record;
   type String_List_Ptr is access all String_List;
   --  No_Strict_Aliasing is necessary here to avoid potential
   --  optimization issues when making unchecked conversions to
   --  String_List_Ptr.
   pragma No_Strict_Aliasing (String_List_Ptr);
   Null_String_List : aliased String_List :=
     (Length => 1, List => (1 => null), Char => (1 => null));
   Null_String_List_Ptr : constant String_List_Ptr :=
      Null_String_List'Access;

   --  We try to represent String_List in a form that does not
   --  require further conversion to pass it to the C interface.
   --  The main problem is that Ada strings carry along "dope"
   --  (including index range info) which will confuse a C subprogram,
   --  but which is needed for proper storage deallocation.
   --  We'd like to simply use char_ptr_ptr, but that does not
   --  give us the length information we need to do storage
   --  deallocation.  Likewise, for the component strings, we
   --  can't just use char_ptr, since that does not carry along
   --  the length information we will need later.  In principle,
   --  we could take advantage of compiler-dependent information
   --  about how arrays are laid out, including the location of
   --  dope, but then we'd have to change this code every time
   --  the compiler changes.  Instead, we create a redundant
   --  data structure, that contains its own dope.

   --  Each element string must be null-terminated, as is
   --  the array of pointers Char.  Thus,
   --  X.Length is not the virtual "length" of the list;
   --  that must be calculated, C-style, by counting positions
   --  until a null element is reached.

   --  We address the problem of predicting the length of
   --  array needed by blocking and recopying if necessary
   --  for the Append operation.
   --  For now, we guess the string length is 16,
   --  and double the length each time it overflows.
   --  On the average, this should result in fewer calls
   --  to malloc() than if we were to use a linked list.

   Min_String_List_Length : constant := 16;

   ----------------------
   --  Signal Masking  --
   ----------------------

   --  The following two also defer/undefer abortion, as side-effects.

   procedure Mask_Signals
     (Masking  : Signal_Masking;
      Old_Mask : Signal_Mask_Access);

   procedure Restore_Signals
     (Masking  : Signal_Masking;
      Old_Mask : Signal_Mask_Access);

   procedure Restore_Signals
     (Old_Mask : Signal_Mask_Access);

   --  The following are provided for exit from a critical
   --  section where error checking needs to be done.  The issue
   --  here is that Restore_Signals may change the value of errno,
   --  so we need to combine the actions into one operation,
   --  saving the errno value over the call to Restore_Signals.

   procedure Restore_Signals_And_Raise_POSIX_Error
     (Masked_Signals : Signal_Masking;
      Old_Mask : Signal_Mask_Access);

   procedure Check_NNeg_And_Restore_Signals
     (Result : POSIX.C.int;
      Masked_Signals : Signal_Masking;
      Old_Mask : Signal_Mask_Access);

   -------------------
   --  Error Codes  --
   -------------------

   --  The following operate on the raw Pthread errno value,
   --  and must be written in C since errno may be accessed via
   --  a macro.

   function Fetch_Errno return Error_Code;
   pragma Import (C, Fetch_Errno, "fetch_errno");

   procedure Store_Errno (value : Error_Code);
   pragma Import (C, Store_Errno, "store_errno");

   --  The following operate on the Ada per-task errno value.
   --  The difference is that this value is not affected by any
   --  implicit OS calls that might occur during the implementation
   --  of exception propagation.

   function Get_Ada_Error_Code return Error_Code;

   procedure Set_Ada_Error_Code (Error : Error_Code);

   package Bogus_Error_Codes is

      --  These names are enclosed in this inner
      --  package to avoid name conflicts
      --  with the real error code constants, which are
      --  exported by this package.

      type Error_Name_Enum is
        (No_Error,
         Argument_List_Too_Long,
         Bad_Address,
         Bad_File_Descriptor,
         Bad_Message,
         Broken_Pipe,
         Directory_Not_Empty,
         Exec_Format_Error,
         File_Exists,
         File_Too_Large,
         Filename_Too_Long,
         Improper_Link,
         Inappropriate_IO_Control_Operation,
         Input_Output_Error,
         Interrupted_Operation,
         Invalid_Argument,
         Invalid_Seek,
         Is_A_Directory,
         Message_Too_Long,
         No_Child_Process,
         No_Locks_Available,
         No_Space_Left_On_Device,
         No_Such_Operation_On_Device,
         No_Such_Device_Or_Address,
         No_Such_File_Or_Directory,
         No_Such_Process,
         Not_A_Directory,
         Not_Enough_Space,
         Operation_Canceled,
         Operation_In_Progress,
         Operation_Not_Implemented,
         Operation_Not_Permitted,
         Operation_Not_Supported,
         Permission_Denied,
         Read_Only_File_System,
         Resource_Busy,
         Resource_Deadlock_Avoided,
         Resource_Temporarily_Unavailable,
         Timed_Out,
         Too_Many_Links,
         Too_Many_Open_Files,
         Too_Many_Open_Files_In_System,
         --  2.4.6 Socket Error Codes from P1003.5c
         Address_In_Use,
         Address_Not_Available,
         Already_Awaiting_Connection,
         Connection_Aborted,
         Connection_Refused,
         Connection_Reset,
         Domain_Error,
         Host_Down,
         Host_Unreachable,
         Inappropriate_Family,
         Is_Already_Connected,
         Network_Down,
         Network_Reset,
         Network_Unreachable,
         No_Buffer_Space,
         Not_A_Socket,
         Not_Connected,
         Option_Not_Supported,
         Protocol_Not_Supported,
         Socket_Not_Supported,
         Unknown_Protocol_Option,
         Would_Block,
         Wrong_Protocol_Type);

      type Error_Array_Type is array (Error_Name_Enum) of Error_Code;
   end Bogus_Error_Codes;

   Error_Array : constant Bogus_Error_Codes.Error_Array_Type :=
     (No_Error, E2BIG, EFAULT, EBADF, EBADMSG, EPIPE, ENOTEMPTY, ENOEXEC,
      EEXIST, EFBIG, ENAMETOOLONG, EXDEV, ENOTTY, EIO, EINTR, EINVAL,
      ESPIPE, EISDIR, EMSGSIZE, ECHILD, ENOLCK, ENOSPC, ENODEV, ENXIO,
      ENOENT, ESRCH, ENOTDIR, ENOMEM, ECANCELED, EINPROGRESS, ENOSYS,
      EPERM, ENOTSUP, EACCES, EROFS, EBUSY, EDEADLK, EAGAIN, ETIMEDOUT,
      EMLINK, EMFILE, ENFILE,
      --  2.4.6 Socket Error Codes from P1003.5c
      EADDRINUSE, EADDRNOTAVAIL, EALREADY, ECONNABORTED, ECONNREFUSED,
      ECONNRESET, EDOM, EHOSTDOWN, EHOSTUNREACH, EAFNOSUPPORT, EISCONN,
      ENETDOWN, ENETRESET, ENETUNREACH, ENOBUFS, ENOTSOCK, ENOTCONN,
      EOPNOTSUPP, EPROTONOSUPPORT, ESOCKTNOSUPPORT, ENOPROTOOPT,
      EWOULDBLOCK, EPROTOTYPE);

   ------------------------
   --  Time Conversions  --
   ------------------------

   NS_per_S : constant := 10#1#E9;
   MS_per_S : constant := 10#1#E6;
   type D_Int is mod 2 ** (Duration'Size);
   function To_D_Int is new Unchecked_Conversion (Duration, D_Int);
   function To_Duration is new Unchecked_Conversion (D_Int, Duration);
   Duration_Delta_Assertion : constant :=
     Boolean'Pos (Boolean'Pred (Duration'Small = 0.000_000_001));

   --  We rely that POSIX.Calendar.Time and Calendar.Time are
   --  implemented using the same representation as Duration, and
   --  both are implemented using a UNIX clock.

   function To_Struct_Timespec (D : Duration) return POSIX.C.struct_timespec;
   function To_Struct_Timespec (T : Timespec) return POSIX.C.struct_timespec;
   function To_Duration (TS : POSIX.C.struct_timespec) return Duration;
   function To_Timespec (TS : POSIX.C.struct_timespec) return Timespec;
   function To_Struct_Timeval (D : Duration) return POSIX.C.struct_timeval;
   function To_Duration (TV : POSIX.C.struct_timeval) return Duration;

end POSIX.Implementation;