DataMuseum.dk

top - download

    Length: 13822 (0x35fe)
    Types: TextFile
    Names: »V«

└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
    └─ ⟦0c20f784e⟧ »DATA« 
        └─⟦1abbe589f⟧ 
            └─⟦059497ac5⟧ 
                └─⟦this⟧ 

TextFile

--/ if R1000 then
with Transport;  
with Transport_Defs;

with System;
--/ elsif Cdf_Hpux then
--// with System_Interface;
--// with Unix_Base_Types;
--/ elsif TeleGen2 and then Unix then
--// with Error_Messages;                        -- Unix Error Codes
--/ end if;

with Unchecked_Deallocation;

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;

package Xlbmt_Network_Types is
------------------------------------------------------------------------------
-- X Library Machine Network Types
--
-- Xlbmt_Network_Types - Machine/Compiler dependent network interface types.
------------------------------------------------------------------------------
-- Copyright 1989 - 1991 by Rational, Santa Clara, California.
--
--                  All Rights Reserved.
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright notice(s) appear in all copies and that
-- both that copyright notice(s) and this permission notice appear in
-- supporting documentation, and that the name of Rational not be used in
-- advertising or publicity pertaining to distribution of the software
-- without specific, written prior permission.
--
-- Rational disclaims all warranties with regard to this software, including
-- all implied warranties of merchantability and fitness, in no event shall
-- Rational be liable for any special, indirect or consequential damages or
-- any damages whatsoever resulting from loss of use, data or profits, whether
-- in an action of contract, negligence or other tortious action, arising out
-- of or in connection with the use or performance of this software.
------------------------------------------------------------------------------

--\f

------------------------------------------------------------------------------
-- Array data type used when reading/writing data from/to the server network
-- connection.
------------------------------------------------------------------------------

--/ if R1000 then

    subtype X_Raw_Data       is System.Byte;  
    subtype X_Raw_Data_Array is System.Byte_String;  
    subtype X_Raw_Data_Index is Natural;

    function "="  (A : X_Raw_Data; B : X_Raw_Data) return Boolean  
        renames System."=";  
    function "<=" (A : X_Raw_Data; B : X_Raw_Data) return Boolean  
        renames System."<=";  
    function ">=" (A : X_Raw_Data; B : X_Raw_Data) return Boolean  
        renames System.">=";  
    function "<"  (A : X_Raw_Data; B : X_Raw_Data) return Boolean  
        renames System."<";  
    function ">"  (A : X_Raw_Data; B : X_Raw_Data) return Boolean  
        renames System.">";  
    function "+"  (A : X_Raw_Data; B : X_Raw_Data) return X_Raw_Data  
        renames System."+";
    -- function "-"   (A : X_Raw_Data) return X_Raw_Data
    --    renames System."-";
    function "abs" (A : X_Raw_Data) return X_Raw_Data  
        renames System."abs";  
    function "-"   (A : X_Raw_Data; B : X_Raw_Data) return X_Raw_Data  
        renames System."-";  
    function "*"   (A : X_Raw_Data; B : X_Raw_Data) return X_Raw_Data  
        renames System."*";  
    function "/"   (A : X_Raw_Data; B : X_Raw_Data) return X_Raw_Data  
        renames System."/";  
    function "rem" (A : X_Raw_Data; B : X_Raw_Data) return X_Raw_Data  
        renames System."rem";  
    function "&"   (A : X_Raw_Data_Array; B : X_Raw_Data_Array)  
                 return X_Raw_Data_Array  
        renames System."&";  
    function "="   (A : X_Raw_Data_Array; B : X_Raw_Data_Array) return Boolean  
        renames System."=";

--/ else
--//
--//     type    X_Raw_Data       is new U_Char;
--//     type    X_Raw_Data_Array is array (S_Natural range <>) of X_Raw_Data;
--//     subtype X_Raw_Data_Index is S_Natural;
--//
--/ end if;

    type X_Raw_Data_List is access X_Raw_Data_Array;

--/ if Pack then
--//     pragma Pack (X_Raw_Data_Array);
--/ end if;
--/ if ENABLE_DEALLOCATION then
    pragma Enable_Deallocation (X_Raw_Data_List);
--/ end if;

    None_X_Raw_Data_List : constant X_Raw_Data_List := null;

    procedure Free_X_Raw_Data_List is  
       new Unchecked_Deallocation (X_Raw_Data_Array,  
                                   X_Raw_Data_List);

--\f

------------------------------------------------------------------------------
-- System Dependent Networking Types
------------------------------------------------------------------------------

--/ if R1000 and R1000_Xlib_Only then
--//
--//     subtype Connection_Id is Transport.Connection_Id;
--//     subtype Host_Id       is Transport_Defs.Host_Id;
--//     subtype Status_Code   is Transport_Defs.Status_Code;
--//
--//     None_Connection_Id : constant Connection_Id := Transport.Null_Connection_Id;
--//
--//     function "=" (A, B : Connection_Id) return Boolean renames Transport."=";
--//     function "=" (A, B : Host_Id) return Boolean renames Transport_Defs."=";
--//     function "=" (A, B : Status_Code) return Boolean renames Transport_Defs."=";
--//
--//     function Image (Code : Status_Code) return String;
--//
--//     Ok             : constant Status_Code := Transport_Defs.Ok;
--//     Timed_Out      : constant Status_Code := Transport_Defs.Timed_Out;
--//     No_Free_Memory : constant Status_Code := Transport_Defs.No_Free_Memory;
--//
--/ elsif R1000 and not R1000_Xlib_Only then

    subtype Host_Id     is Transport_Defs.Host_Id;  
    subtype Status_Code is Transport_Defs.Status_Code;

    function "=" (A, B : Transport.Connection_Id) return Boolean  
        renames Transport."=";  
    function "=" (A, B : Host_Id) return Boolean renames Transport_Defs."=";  
    function "=" (A, B : Status_Code) return Boolean renames Transport_Defs."=";

    function Image (Code : Status_Code) return String;

    Ok             : constant Status_Code := Transport_Defs.Ok;  
    Timed_Out      : constant Status_Code := Transport_Defs.Timed_Out;  
    No_Free_Memory : constant Status_Code := Transport_Defs.No_Free_Memory;

    task type Notify_Complete_Task is  
        entry Set_Not_Done;             -- Called to reset flag
        entry Set_Done;                 -- Called to set flag
        entry Wait_For_Done;            -- Called to wait for set flag
    end Notify_Complete_Task;

    type Notify_Complete is access Notify_Complete_Task;

    pragma Enable_Deallocation (Notify_Complete);

    None_Notify_Complete : constant Notify_Complete := null;

    type Connection_State is (Pending_Read_None,  
                              Pending_Read_Wait,  
                              Pending_Read_Done);

    type Connection_Id_Rec;  
    type Connection_Id is access Connection_Id_Rec;

    task type Connection_Reader is  
        entry Initialize    (Connection : Connection_Id);  
        entry Receive_Maybe (Status : out    Status_Code;  
                             Data   : in out X_Raw_Data_Array;  
                             Count  : out    X_Raw_Data_Index);  
        entry Receive_Queue (Status : out    Status_Code;  
                             Data   : in out X_Raw_Data_Array;  
                             Count  : out    X_Raw_Data_Index;  
                             Notify :        Notify_Complete);  
        entry Receive_Must  (Status : out    Status_Code;  
                             Data   : in out X_Raw_Data_Array;  
                             Count  : out    X_Raw_Data_Index);  
    end Connection_Reader;

    type Connection_Id_Rec is  
        record  
            Connection : Transport.Connection_Id :=  
               Transport.Null_Connection_Id;  
            State      : Connection_State        := Pending_Read_None;  
            Reader     : Connection_Reader;  
        end record;

    pragma Enable_Deallocation (Connection_Id);

    None_Connection_Id : constant Connection_Id := null;

    procedure Free_Connection_Id is  
       new Unchecked_Deallocation (Connection_Id_Rec,  
                                   Connection_Id);

--/ elsif Cdf_Hpux then
--//
--// ------------------------------------------------------------------------------
--// -- Connection_Id - socket number
--// ------------------------------------------------------------------------------
--//
--//     type Connection_Id is new S_Long;
--//
--//     None_Connection_Id : constant Connection_Id := 0;
--//
--// ------------------------------------------------------------------------------
--// -- Host_Id - An encoding of a network host address
--// ------------------------------------------------------------------------------
--//
--//     type Host_Id is new S_Long;
--//
--// ------------------------------------------------------------------------------
--// -- Status_Code - An encoding of the outcome of a Transport operation.
--// --
--// --  Ok              - it worked
--// --  Timed_Out       - it has a time-limit and that limit expired
--// --  Error           - nonspecific error
--// ------------------------------------------------------------------------------
--//
--//     subtype Status_Code is Unix_Base_Types.Int;
--//
--//     function Image (Code : Status_Code) return String;
--//     function Get_Errno                  return Status_Code;
--//
--//     Ok             : constant Status_Code := 0;
--//     Timed_Out      : constant Status_Code := System_Interface.Error.Ewouldblock;
--//     No_Free_Memory : constant Status_Code := System_Interface.Error.Enomem;
--//
--/ elsif TeleGen2 and then Unix then
--//
--// ------------------------------------------------------------------------------
--// -- Connection_Id - socket number
--// ------------------------------------------------------------------------------
--//
--//     type Connection_Id is new S_Long;
--//
--//     None_Connection_Id : constant Connection_Id := 0;
--//
--// ------------------------------------------------------------------------------
--// -- Host_Id - An encoding of a network host address
--// ------------------------------------------------------------------------------
--//
--//     type Host_Id is new S_Long;
--//
--// ------------------------------------------------------------------------------
--// -- Status_Code - An encoding of the outcome of a Transport operation.
--// --
--// --  Ok              - it worked
--// --  Timed_Out       - it has a time-limit and that limit expired
--// --  Error           - nonspecific error
--// ------------------------------------------------------------------------------
--//
--//     type Status_Code is new Error_Messages.Errors;
--//
--//     function Image (Code : Status_Code) return String;
--//     function Get_Errno                  return Status_Code;
--//
--//     Ok             : constant Status_Code := Enoerror;
--//     Timed_Out      : constant Status_Code := Ewouldblock;
--//     No_Free_Memory : constant Status_Code := Enomem;
--//
--/ else
--//
--//     Need : Something_Here;
--//
--/ end if;

--\f

------------------------------------------------------------------------------
-- X_Buffer - X_Display I/O Buffer type
------------------------------------------------------------------------------

    type X_Buffer (Length : X_Raw_Data_Index) is  
        record  
            Used : X_Raw_Data_Index := 0;  
            Data : X_Raw_Data_Array (1 .. Length);  
        end record;

------------------------------------------------------------------------------
-- X_Mutex - Multitask mutual exclusion type.
------------------------------------------------------------------------------

--/ if not Multitask_Locking then
--//
--//    type X_Mutex_Rec is
--//        record
--//            Flop : S_Natural range 0 .. 1 := 0;
--//        end record;
--//
--/ else

    task type X_Mutex_Rec is  
        entry Lock;  
        entry Unlock;  
        entry Destroy_Self;  
    end X_Mutex_Rec;

--/ end if;

    type X_Mutex is access X_Mutex_Rec;

--/ if ENABLE_DEALLOCATION then
    pragma Enable_Deallocation (X_Mutex);
--/ end if;

    procedure Free_X_Mutex (M : in out X_Mutex);

    procedure Lock_Mutex   (Mutex : X_Mutex);  
    procedure Unlock_Mutex (Mutex : X_Mutex);
------------------------------------------------------------------------------
--  Mutex - Specifies the X_Mutex to un/locak
--
-- If you don't want to know whether or not multitask locking is implemented
-- for a particular library then use these procedures to lock/unlock a mutex.
--
-- If, for this machine/OS/Ada-compiler combination, multi-task-locking is not
-- supported for the X_Library then we raise X_Library_Confusion if two
-- Lock_Mutex calls are made in succession, two Unlock_Mutex calls are made
-- in succession, or if Unlock is called when the lock was not Lock'ed.
--
-- Use the (Un)Lock_Display routines to lock/unlock the X_Mutex'es for
-- X_Display's.
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- X_Network_Connection
------------------------------------------------------------------------------

    type X_Network_Connection is  
        record  
            Fd : Connection_Id;
            ----Network socket.
            Fd_Error : Status_Code := Ok;  
        end record;

------------------------------------------------------------------------------
-- X_Network_Host_Address
------------------------------------------------------------------------------

    type X_Network_Host_Address is access Host_Id;

--/ if ENABLE_DEALLOCATION then
    pragma Enable_Deallocation (X_Network_Host_Address);
--/ end if;

    procedure Free_X_Network_Host_Address is  
       new Unchecked_Deallocation (Host_Id,  
                                   X_Network_Host_Address);

    None_X_Network_Host_Address : constant X_Network_Host_Address := null;

end Xlbmt_Network_Types;