mirror of
https://github.com/AdaCore/florist.git
synced 2026-02-12 13:10:32 -08:00
ce3007c68b
GNAT already emits a style warning when redundant parentheses appear inside logical and short-circuit operators; this warning will be soon emitted for unary operators as well.
870 lines
23 KiB
Ada
870 lines
23 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- FLORIST (FSU Implementation of POSIX.5) COMPONENTS --
|
|
-- --
|
|
-- P O S I X --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- Copyright (C) 1996-1997 Florida State University --
|
|
-- Copyright (C) 1998-2022, AdaCore --
|
|
-- --
|
|
-- 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. --
|
|
-- --
|
|
-- As a special exception, if other files instantiate generics from this --
|
|
-- unit, or you link this unit with other files to produce an executable, --
|
|
-- this unit does not by itself cause the resulting executable to be --
|
|
-- covered by the GNU General Public License. This exception does not --
|
|
-- however invalidate any other reasons why the executable file might be --
|
|
-- covered by the GNU Public License. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
with Ada.Unchecked_Conversion,
|
|
Ada.Unchecked_Deallocation,
|
|
POSIX.C,
|
|
POSIX.Implementation,
|
|
System;
|
|
|
|
pragma Elaborate (POSIX.C);
|
|
pragma Elaborate (POSIX.Implementation);
|
|
|
|
package body POSIX is
|
|
|
|
use Ada.Streams;
|
|
use POSIX.C;
|
|
use POSIX.Implementation;
|
|
|
|
type String_List is new POSIX.Implementation.String_List;
|
|
|
|
-----------------------------
|
|
-- Unchecked Conversions --
|
|
-----------------------------
|
|
|
|
type Big_POSIX_String_Ptr is access all POSIX_String (Positive'Range);
|
|
type Big_Stream_Element_Array_Ptr is access all
|
|
Stream_Element_Array (Stream_Element_Offset);
|
|
|
|
function From_Address is new Ada.Unchecked_Conversion
|
|
(System.Address, Big_POSIX_String_Ptr);
|
|
function From_Address is new Ada.Unchecked_Conversion
|
|
(System.Address, Big_Stream_Element_Array_Ptr);
|
|
|
|
-----------------------
|
|
-- To_POSIX_String --
|
|
-----------------------
|
|
|
|
function To_POSIX_String (Str : String) return POSIX_String is
|
|
begin
|
|
return POSIX_String (Str);
|
|
end To_POSIX_String;
|
|
|
|
-----------------
|
|
-- To_String --
|
|
-----------------
|
|
|
|
function To_String (Str : POSIX_String) return String is
|
|
begin
|
|
return String (Str);
|
|
end To_String;
|
|
|
|
----------------------
|
|
-- To_Wide_String --
|
|
----------------------
|
|
|
|
function To_Wide_String (Str : POSIX_String)
|
|
return Wide_String is
|
|
Result : Wide_String (Str'Range);
|
|
begin
|
|
for I in Str'Range loop
|
|
Result (I) :=
|
|
Wide_Character'Val (POSIX_Character'Pos (Str (I)));
|
|
end loop;
|
|
return Result;
|
|
end To_Wide_String;
|
|
|
|
-- We cannot use direct unchecked conversion here,
|
|
-- since the sizes of the characters are different.
|
|
-- However, we rely that the integer codes for the
|
|
-- first 256 wide characters are the same as those
|
|
-- of the ordinary characters. [See ARM A.1 (36)]
|
|
|
|
-----------------------
|
|
-- To_POSIX_String --
|
|
-----------------------
|
|
|
|
function To_POSIX_String (Str : Wide_String)
|
|
return POSIX_String is
|
|
Result : POSIX_String (Str'Range);
|
|
begin
|
|
for I in Str'Range loop
|
|
Result (I) := POSIX_Character'Val
|
|
(Wide_Character'Pos (Str (I)) rem 256);
|
|
end loop;
|
|
return Result;
|
|
end To_POSIX_String;
|
|
|
|
-------------------------------
|
|
-- To_Stream_Element_Array --
|
|
-------------------------------
|
|
|
|
function To_Stream_Element_Array (Buffer : POSIX_String)
|
|
return Ada.Streams.Stream_Element_Array
|
|
is
|
|
subtype Offset is Stream_Element_Offset;
|
|
begin
|
|
return From_Address (Buffer'Address)
|
|
((Offset (Buffer'First) + Offset'First - 1) ..
|
|
(Offset (Buffer'Last) + Offset'First - 1));
|
|
end To_Stream_Element_Array;
|
|
|
|
-----------------------
|
|
-- To_POSIX_String --
|
|
-----------------------
|
|
|
|
function To_POSIX_String
|
|
(Buffer : Ada.Streams.Stream_Element_Array) return POSIX_String
|
|
is
|
|
subtype Offset is Stream_Element_Offset;
|
|
begin
|
|
return From_Address (Buffer'Address)
|
|
(Positive (Buffer'First - Offset'First + 1) ..
|
|
Positive (Buffer'Last - Offset'First + 1));
|
|
end To_POSIX_String;
|
|
|
|
-------------------
|
|
-- Is_Filename --
|
|
-------------------
|
|
|
|
function Is_Filename (Str : POSIX_String) return Boolean is
|
|
begin
|
|
if To_String (Str)'Length = 0 then
|
|
return False;
|
|
end if;
|
|
for I in Str'Range loop
|
|
if Str (I) = '/' or Str (I) = NUL or Str (I) = ' ' then
|
|
return False;
|
|
end if;
|
|
end loop;
|
|
return True;
|
|
end Is_Filename;
|
|
|
|
-- These two functions (Is_Pathname and Is_Filename) seem
|
|
-- not to be unimplementable in a portable way, since they are
|
|
-- supposed to "check all constraints set on filename and
|
|
-- pathname by the implementation that can be checked without
|
|
-- accessing the file system directly.
|
|
|
|
-------------------
|
|
-- Is_Pathname --
|
|
-------------------
|
|
|
|
function Is_Pathname (Str : POSIX_String) return Boolean is
|
|
begin
|
|
if To_String (Str)'Length = 0 then
|
|
return False;
|
|
end if;
|
|
for I in Str'Range loop
|
|
if Str (I) = NUL or Str (I) = ' ' then
|
|
return False;
|
|
end if;
|
|
end loop;
|
|
return True;
|
|
end Is_Pathname;
|
|
|
|
----------------------------
|
|
-- Is_Portable_filename --
|
|
----------------------------
|
|
|
|
function Is_Portable_Filename (Str : POSIX_String)
|
|
return Boolean is
|
|
begin
|
|
if To_String (Str)'Length = 0 then
|
|
return False;
|
|
end if;
|
|
for I in Str'Range loop
|
|
case Str (I) is
|
|
when 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '.' | '_' =>
|
|
null;
|
|
when '-' =>
|
|
if I = Str'First then
|
|
return False;
|
|
end if;
|
|
when others =>
|
|
return False;
|
|
end case;
|
|
end loop;
|
|
return True;
|
|
end Is_Portable_Filename;
|
|
|
|
----------------------------
|
|
-- Is_Portable_Pathname --
|
|
----------------------------
|
|
|
|
function Is_Portable_Pathname (Str : POSIX_String)
|
|
return Boolean is
|
|
Start : Positive;
|
|
P : Positive;
|
|
begin
|
|
if To_String (Str)'Length = 0 then
|
|
return False;
|
|
end if;
|
|
Start := Str'First;
|
|
P := Str'First;
|
|
loop
|
|
if P > Str'Last or else Str (P) = '/' then
|
|
if Start < P and then not
|
|
Is_Portable_Filename (Str (Start .. P - 1))
|
|
then
|
|
return False;
|
|
end if;
|
|
if P > Str'Last then
|
|
return True;
|
|
end if;
|
|
Start := P + 1;
|
|
end if;
|
|
P := P + 1;
|
|
end loop;
|
|
end Is_Portable_Pathname;
|
|
|
|
------------------
|
|
-- Make_Empty --
|
|
------------------
|
|
|
|
procedure Free is
|
|
new Ada.Unchecked_Deallocation (POSIX_String, POSIX_String_Ptr);
|
|
|
|
procedure Free is
|
|
new Ada.Unchecked_Deallocation (String_List, POSIX_String_List);
|
|
|
|
procedure Make_Empty (List : in out POSIX_String_List) is
|
|
begin
|
|
if List = null then
|
|
return;
|
|
end if;
|
|
for I in 1 .. List.Length loop
|
|
if List.List (I) = null then
|
|
exit;
|
|
end if;
|
|
Free (List.List (I));
|
|
end loop;
|
|
Free (List);
|
|
end Make_Empty;
|
|
|
|
--------------
|
|
-- Append --
|
|
--------------
|
|
|
|
procedure Append
|
|
(List : in out POSIX_String_List;
|
|
Str : POSIX_String) is
|
|
Tmp : POSIX_String_List;
|
|
Len : constant Integer := Str'Length;
|
|
begin
|
|
if List = null then
|
|
List := new String_List (Min_String_List_Length);
|
|
-- rely that pointers all initialized to null
|
|
end if;
|
|
for I in 1 .. List.Length loop
|
|
if List.List (I) = null then
|
|
if I = List.Length then
|
|
Tmp := new String_List (2 * List.Length);
|
|
Tmp.List (List.List'Range) := List.List;
|
|
Tmp.Char (List.List'Range) := List.Char;
|
|
Free (List); List := Tmp;
|
|
end if;
|
|
List.List (I) := new POSIX_String (1 .. Len + 1);
|
|
List.List (I)(1 .. Len) := Str;
|
|
List.List (I)(Len + 1) := NUL;
|
|
List.Char (I) := List.List (I)(1)'Unchecked_Access;
|
|
return;
|
|
end if;
|
|
end loop;
|
|
end Append;
|
|
|
|
----------------------
|
|
-- For_Every_Item --
|
|
----------------------
|
|
|
|
-- generic
|
|
-- with procedure Action
|
|
-- (Item: POSIX_String; Quit: in out Boolean);
|
|
procedure For_Every_Item (List : POSIX_String_List) is
|
|
Quit : Boolean := False;
|
|
begin
|
|
if List = null then
|
|
return;
|
|
end if;
|
|
for I in 1 .. List.Length loop
|
|
exit when List.List (I) = null;
|
|
declare
|
|
L : constant Integer := List.List (I)'Length;
|
|
begin
|
|
Action (List.List (I)(1 .. L - 1), Quit);
|
|
end;
|
|
exit when Quit;
|
|
end loop;
|
|
end For_Every_Item;
|
|
|
|
--------------
|
|
-- Length --
|
|
--------------
|
|
|
|
function Length (List : POSIX_String_List)
|
|
return Natural is
|
|
begin
|
|
if List = null then
|
|
return 0;
|
|
end if;
|
|
for I in 1 .. List.Length loop
|
|
if List.List (I) = null then
|
|
return Natural (I - 1);
|
|
end if;
|
|
end loop;
|
|
raise Program_Error;
|
|
return 0;
|
|
end Length;
|
|
|
|
-------------
|
|
-- Value --
|
|
-------------
|
|
|
|
function Value
|
|
(List : POSIX_String_List;
|
|
Index : Positive)
|
|
return POSIX_String is
|
|
I : constant Positive := Index;
|
|
begin
|
|
if List = null
|
|
or else not (I <= List.Length)
|
|
or else List.List (I) = null
|
|
then
|
|
raise Constraint_Error;
|
|
end if;
|
|
|
|
declare
|
|
L : constant Integer := List.List (I).all'Length;
|
|
begin
|
|
return List.List (I)(1 .. L - 1);
|
|
end;
|
|
end Value;
|
|
|
|
-----------------
|
|
-- Empty_set --
|
|
-----------------
|
|
|
|
function Empty_Set return Option_Set is
|
|
begin
|
|
return (Option => 0);
|
|
end Empty_Set;
|
|
|
|
-----------
|
|
-- "+" --
|
|
-----------
|
|
|
|
function "+" (L, R : Option_Set) return Option_Set is
|
|
begin
|
|
return (Option => Bits (unsigned (L.Option) or unsigned (R.Option)));
|
|
end "+";
|
|
|
|
-----------
|
|
-- "-" --
|
|
-----------
|
|
|
|
function "-" (L, R : Option_Set) return Option_Set is
|
|
begin
|
|
return (Option =>
|
|
Bits (unsigned (L.Option) and not unsigned (R.Option)));
|
|
end "-";
|
|
|
|
---------
|
|
-- < --
|
|
---------
|
|
|
|
function "<" (Left, Right : Option_Set) return Boolean is
|
|
begin
|
|
return Left <= Right and Left /= Right;
|
|
end "<";
|
|
|
|
---------
|
|
-- <= --
|
|
---------
|
|
|
|
function "<=" (Left, Right : Option_Set) return Boolean is
|
|
begin
|
|
return ((not Bits (unsigned (Right.Option))) and
|
|
Bits (unsigned (Left.Option))) = 0;
|
|
end "<=";
|
|
|
|
---------
|
|
-- > --
|
|
---------
|
|
|
|
function ">" (Left, Right : Option_Set) return Boolean is
|
|
begin
|
|
return Right < Left;
|
|
end ">";
|
|
|
|
----------
|
|
-- >= --
|
|
----------
|
|
|
|
function ">=" (Left, Right : Option_Set) return Boolean is
|
|
begin
|
|
return Right <= Left;
|
|
end ">=";
|
|
|
|
----------------------
|
|
-- Get_Error_Code --
|
|
----------------------
|
|
|
|
function Get_Error_Code return Error_Code is
|
|
begin
|
|
return POSIX.Implementation.Get_Ada_Error_Code;
|
|
end Get_Error_Code;
|
|
|
|
----------------------
|
|
-- Set_Error_Code --
|
|
----------------------
|
|
|
|
procedure Set_Error_Code (Error : Error_Code) is
|
|
begin
|
|
POSIX.Implementation.Set_Ada_Error_Code (Error);
|
|
end Set_Error_Code;
|
|
|
|
----------------------
|
|
-- Is_POSIX_Error --
|
|
----------------------
|
|
|
|
function Is_POSIX_Error (Error : Error_Code) return Boolean is
|
|
begin
|
|
for I in Error_Array'Range loop
|
|
if Error = Error_Array (I) then
|
|
return True;
|
|
end if;
|
|
end loop;
|
|
return False;
|
|
end Is_POSIX_Error;
|
|
|
|
-------------
|
|
-- Image --
|
|
-------------
|
|
|
|
function Image (Error : Error_Code) return String is
|
|
use Bogus_Error_Codes;
|
|
begin
|
|
for I in Error_Array'Range loop
|
|
if Error = Error_Array (I) then
|
|
return Error_Name_Enum'Image (I);
|
|
end if;
|
|
end loop;
|
|
declare
|
|
Tmp : constant String := Error_Code'Image (Error);
|
|
begin
|
|
if Tmp (Tmp'First) /= ' ' then
|
|
return Tmp;
|
|
end if;
|
|
return Tmp (Tmp'First + 1 .. Tmp'Last);
|
|
end;
|
|
end Image;
|
|
|
|
-------------------------
|
|
-- Print_Error_Message --
|
|
-------------------------
|
|
|
|
procedure Print_Error_Message is
|
|
procedure perror (Ignore : System.Address := System.Null_Address);
|
|
pragma Import (C, perror, XTI.perror_LINKNAME);
|
|
begin
|
|
if C.XTI.HAVE_perror then
|
|
perror;
|
|
else
|
|
declare
|
|
Text : constant String := Image (Get_Error_Code) & ASCII.LF;
|
|
procedure write
|
|
(fildes : int; buf : System.Address; nbyte : size_t);
|
|
pragma Import (C, write, write_LINKNAME);
|
|
-- Unable to use Write and Standard_Error from POSIX.IO directly
|
|
-- because of cyclic dependencies.
|
|
begin
|
|
write (2, Text'Address, Text'Length);
|
|
end;
|
|
end if;
|
|
end Print_Error_Message;
|
|
|
|
function uname (name : access struct_utsname)
|
|
return int;
|
|
pragma Import (C, uname, uname_LINKNAME);
|
|
|
|
-------------------
|
|
-- System_Name --
|
|
-------------------
|
|
|
|
function System_Name return POSIX_String is
|
|
Name : aliased struct_utsname;
|
|
begin
|
|
Check (uname (Name'Unchecked_Access));
|
|
return Form_POSIX_String (Name.sysname (1)'Unchecked_Access);
|
|
end System_Name;
|
|
|
|
-----------------
|
|
-- Node_Name --
|
|
-----------------
|
|
|
|
function Node_Name return POSIX_String is
|
|
Name : aliased struct_utsname;
|
|
begin
|
|
Check (uname (Name'Unchecked_Access));
|
|
return Form_POSIX_String (Name.nodename (1)'Unchecked_Access);
|
|
end Node_Name;
|
|
|
|
---------------
|
|
-- Release --
|
|
---------------
|
|
|
|
function Release return POSIX_String is
|
|
Name : aliased struct_utsname;
|
|
begin
|
|
Check (uname (Name'Unchecked_Access));
|
|
return Form_POSIX_String (Name.release (1)'Unchecked_Access);
|
|
end Release;
|
|
|
|
---------------
|
|
-- Version --
|
|
---------------
|
|
|
|
function Version return POSIX_String is
|
|
Name : aliased struct_utsname;
|
|
begin
|
|
Check (uname (Name'Unchecked_Access));
|
|
return Form_POSIX_String (Name.version (1)'Unchecked_Access);
|
|
end Version;
|
|
|
|
---------------
|
|
-- Machine --
|
|
---------------
|
|
|
|
function Machine return POSIX_String is
|
|
Name : aliased struct_utsname;
|
|
begin
|
|
Check (uname (Name'Unchecked_Access));
|
|
return Form_POSIX_String (Name.machine (1)'Unchecked_Access);
|
|
end Machine;
|
|
|
|
-----------------------------------------
|
|
-- Timespec Composition/Decomposition --
|
|
-----------------------------------------
|
|
|
|
procedure Split
|
|
(D : Duration;
|
|
S : out Duration;
|
|
NS : out Duration);
|
|
pragma Inline (Split);
|
|
-- Decompose D into seconds (S) and nanoseconds (NS) parts,
|
|
-- with the nanosecond part in the range 0.0 .. 0.999999999.
|
|
|
|
procedure Split
|
|
(D : Duration;
|
|
S : out Duration;
|
|
NS : out Duration) is
|
|
begin
|
|
S := POSIX.Implementation.To_Duration
|
|
(To_D_Int (D / NS_per_S) * NS_per_S);
|
|
NS := D - S;
|
|
if NS < 0.0 then
|
|
S := S - 1.0;
|
|
NS := NS + 1.0;
|
|
end if;
|
|
end Split;
|
|
|
|
-------------
|
|
-- Split --
|
|
-------------
|
|
|
|
procedure Split
|
|
(Time : Timespec;
|
|
S : out Seconds;
|
|
NS : out Nanoseconds) is
|
|
SD, NSD : Duration;
|
|
begin
|
|
Split (Time.Val, S => SD, NS => NSD);
|
|
S := Seconds (SD); NS := Nanoseconds (NSD * NS_per_S);
|
|
end Split;
|
|
|
|
-------------------
|
|
-- To_Timespec --
|
|
-------------------
|
|
|
|
function To_Timespec
|
|
(S : Seconds;
|
|
NS : Nanoseconds) return Timespec is
|
|
begin
|
|
return Timespec'
|
|
(Val => Duration (S) + Duration (NS) / NS_per_S);
|
|
end To_Timespec;
|
|
|
|
-------------------
|
|
-- Get_Seconds --
|
|
-------------------
|
|
|
|
function Get_Seconds (Time : Timespec) return Seconds is
|
|
SD, NSD : Duration;
|
|
begin
|
|
Split (Time.Val, S => SD, NS => NSD);
|
|
return Seconds (SD);
|
|
end Get_Seconds;
|
|
|
|
-----------------------
|
|
-- Get_Nanoseconds --
|
|
-----------------------
|
|
|
|
function Get_Nanoseconds (Time : Timespec) return Nanoseconds is
|
|
SD, NSD : Duration;
|
|
begin
|
|
Split (Time.Val, S => SD, NS => NSD);
|
|
return Nanoseconds (NSD * NS_per_S);
|
|
end Get_Nanoseconds;
|
|
|
|
-----------------------
|
|
-- Set_Nanoseconds --
|
|
-----------------------
|
|
|
|
procedure Set_Nanoseconds
|
|
(Time : in out Timespec;
|
|
NS : Nanoseconds)
|
|
is
|
|
SD, NSD : Duration;
|
|
begin
|
|
Split (Time.Val, S => SD, NS => NSD);
|
|
Time.Val := SD + Duration (NS) / NS_per_S;
|
|
end Set_Nanoseconds;
|
|
|
|
-------------------
|
|
-- Set_Seconds --
|
|
-------------------
|
|
|
|
procedure Set_Seconds
|
|
(Time : in out Timespec;
|
|
S : Seconds)
|
|
is
|
|
SD, NSD : Duration;
|
|
begin
|
|
Split (Time.Val, S => SD, NS => NSD);
|
|
Time.Val := Duration (S) + NSD;
|
|
end Set_Seconds;
|
|
|
|
-----------
|
|
-- "+" --
|
|
-----------
|
|
|
|
function "+" (Left, Right : Timespec) return Timespec is
|
|
begin
|
|
return Timespec'(Val => Left.Val + Right.Val);
|
|
end "+";
|
|
|
|
-----------
|
|
-- "+" --
|
|
-----------
|
|
|
|
function "+" (Left : Timespec; Right : Nanoseconds)
|
|
return Timespec is
|
|
begin
|
|
return Timespec'
|
|
(Val => Left.Val + Duration (Right) / NS_per_S);
|
|
end "+";
|
|
|
|
-----------
|
|
-- "-" --
|
|
-----------
|
|
|
|
function "-" (Right : Timespec) return Timespec is
|
|
begin
|
|
return Timespec'(Val => -Right.Val);
|
|
end "-";
|
|
|
|
-----------
|
|
-- "-" --
|
|
-----------
|
|
|
|
function "-" (Left, Right : Timespec) return Timespec is
|
|
begin
|
|
return Timespec'(Val => Left.Val - Right.Val);
|
|
end "-";
|
|
|
|
-----------
|
|
-- "-" --
|
|
-----------
|
|
|
|
function "-" (Left : Timespec; Right : Nanoseconds)
|
|
return Timespec is
|
|
begin
|
|
return Timespec'(Val => Left.Val - Duration (Right) / NS_per_S);
|
|
end "-";
|
|
|
|
-----------
|
|
-- "*" --
|
|
-----------
|
|
|
|
function "*" (Left : Timespec; Right : Integer)
|
|
return Timespec is
|
|
begin
|
|
return Timespec'(Val => Left.Val * Duration (Right));
|
|
end "*";
|
|
|
|
-----------
|
|
-- "*" --
|
|
-----------
|
|
|
|
function "*" (Left : Integer; Right : Timespec)
|
|
return Timespec is
|
|
begin
|
|
return Timespec'(Val => Left * Right.Val);
|
|
end "*";
|
|
|
|
-----------
|
|
-- "/" --
|
|
-----------
|
|
|
|
function "/" (Left : Timespec; Right : Integer)
|
|
return Timespec is
|
|
begin
|
|
return Timespec'(Val => Left.Val / Right);
|
|
end "/";
|
|
|
|
-----------
|
|
-- "/" --
|
|
-----------
|
|
|
|
function "/" (Left, Right : Timespec) return Integer is
|
|
begin
|
|
return Integer (Left.Val / Right.Val);
|
|
end "/";
|
|
|
|
-----------
|
|
-- "<" --
|
|
-----------
|
|
|
|
function "<" (Left, Right : Timespec) return Boolean is
|
|
begin
|
|
return Left.Val < Right.Val;
|
|
end "<";
|
|
|
|
-----------
|
|
-- "<=" --
|
|
-----------
|
|
|
|
function "<=" (Left, Right : Timespec) return Boolean is
|
|
begin
|
|
return Left.Val <= Right.Val;
|
|
end "<=";
|
|
|
|
-----------
|
|
-- ">" --
|
|
-----------
|
|
|
|
function ">" (Left, Right : Timespec) return Boolean is
|
|
begin
|
|
return Right <= Left;
|
|
end ">";
|
|
|
|
------------
|
|
-- ">=" --
|
|
------------
|
|
|
|
function ">=" (Left, Right : Timespec) return Boolean is
|
|
begin
|
|
return Right < Left;
|
|
end ">=";
|
|
|
|
-------------------
|
|
-- To_Timespec --
|
|
-------------------
|
|
|
|
function To_Timespec (D : Duration) return Timespec is
|
|
begin
|
|
return Timespec'(Val => D);
|
|
end To_Timespec;
|
|
|
|
-------------------
|
|
-- To_Duration --
|
|
-------------------
|
|
|
|
function To_Duration (Time : Timespec) return Duration is
|
|
begin
|
|
return Time.Val;
|
|
end To_Duration;
|
|
|
|
--------------------------------
|
|
-- Host_To_Network_Byte_Order --
|
|
--------------------------------
|
|
|
|
function Host_To_Network_Byte_Order
|
|
(Host_32 : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
|
|
is
|
|
function c_htonl
|
|
(host_32 : Interfaces.Unsigned_32) return Interfaces.Unsigned_32;
|
|
pragma Import (C, c_htonl, "c_htonl");
|
|
|
|
begin
|
|
return c_htonl (Host_32);
|
|
end Host_To_Network_Byte_Order;
|
|
|
|
function Host_To_Network_Byte_Order
|
|
(Host_16 : Interfaces.Unsigned_16) return Interfaces.Unsigned_16
|
|
is
|
|
function c_htons
|
|
(host_16 : Interfaces.Unsigned_16) return Interfaces.Unsigned_16;
|
|
pragma Import (C, c_htons, "c_htons");
|
|
|
|
begin
|
|
return c_htons (Host_16);
|
|
end Host_To_Network_Byte_Order;
|
|
|
|
--------------------------------
|
|
-- Host_To_Network_Byte_Order --
|
|
--------------------------------
|
|
|
|
function Network_To_Host_Byte_Order
|
|
(Host_32 : Interfaces.Unsigned_32) return Interfaces.Unsigned_32
|
|
is
|
|
function c_ntohl
|
|
(host_32 : Interfaces.Unsigned_32) return Interfaces.Unsigned_32;
|
|
pragma Import (C, c_ntohl, "c_ntohl");
|
|
|
|
begin
|
|
return c_ntohl (Host_32);
|
|
end Network_To_Host_Byte_Order;
|
|
|
|
function Network_To_Host_Byte_Order
|
|
(Host_16 : Interfaces.Unsigned_16) return Interfaces.Unsigned_16
|
|
is
|
|
function c_ntohs
|
|
(host_16 : Interfaces.Unsigned_16) return Interfaces.Unsigned_16;
|
|
pragma Import (C, c_ntohs, "c_ntohs");
|
|
|
|
begin
|
|
return c_ntohs (Host_16);
|
|
end Network_To_Host_Byte_Order;
|
|
|
|
begin
|
|
-- We rely on Duration being an exact count of nanoseconds
|
|
|
|
pragma Assert (Duration'Small = 1.0 / NS_per_S);
|
|
null;
|
|
end POSIX;
|