DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦f51543b1b⟧ TextFile

    Length: 16011 (0x3e8b)
    Types: TextFile
    Names: »B«

Derivation

└─⟦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;
--/ end if;

with Unchecked_Deallocation;

with Xlbt_Exceptions;  
use Xlbt_Exceptions;

package body 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.
------------------------------------------------------------------------------

--/ if Multitask_Locking then

    procedure Heap_Free_X_Mutex is new Unchecked_Deallocation (X_Mutex_Rec,  
                                                               X_Mutex);

--/ end if;

--\f

--/ if R1000 and not R1000_Xlib_Only then

    task body Notify_Complete_Task is
------------------------------------------------------------------------------
-- Simple bistable flag with multitask interlocking.  Only the Xt reader will
-- ever call Set_Not_Done or Wait_For_Done.  Only Connection_Readers will
-- ever call Set_Done.
--
--  - when Xt wants to read from its display(s) it will call Read_Queue
--      on each one and will call Set_Not_Done when the first one comes
--      back with status Pending_Read_Wait
--  - when Xt has called Read_Queue on each display it will call Wait_For_Done
--      which will only rendezvous when some display has read something
--  - Connection_Readers attempt to do a read; when that fails they change
--      their state to Pending_Read_Wait and leave the rendezvous (Xt then
--      continues); the readers then wait forever for a read to complete;
--      when it completes they set their state to Pending_Read_Done and then
--      call Set_Done; this ordering guarantees that Xt doesn't have to call
--      Set_Not_Done before Read_Queue and that no read completion will get
--      lost if Xt does Set_Not_Done and *then* checks the state; Xt will
--      shortly call Wait_For_Done which would then complete.
------------------------------------------------------------------------------
        Flag : Boolean := False;
    begin

----Loop forever.

        loop

----If the flag is not set then only calls to set/reset it are accepted.

            select
                accept Set_Not_Done do
                    Flag := False;          -- Called to reset flag
                end Set_Not_Done;
            or
                accept Set_Done do
                    Flag := True;           -- Called to set flag
                end Set_Done;
            or
                terminate;
            end select;

----If the flag is set then all calls are allowed.

            while Flag loop
                select
                    accept Set_Not_Done do
                        Flag := False;      -- Called to reset flag
                    end Set_Not_Done;
                or
                    accept Set_Done do
                        Flag := True;       -- Called to set flag
                    end Set_Done;
                or
                    accept Wait_For_Done do
                        Flag := False;      -- Called to wait for set flag
                    end Wait_For_Done;      -- There is only one wait'er.
                or
                    terminate;
                end select;
            end loop;
        end loop;

    end Notify_Complete_Task;

--/ end if;

--\f

--/ if R1000 and not R1000_Xlib_Only then

    task body Connection_Reader is
------------------------------------------------------------------------------
-- Reader task for all Xlib connections.  The Xlib will only call the
-- Maybe or the Must entries.  The Xt calls the Queue entry when it would like
-- to read but doesn't want to wait if there is nothing ready.  A Queue'd
-- read will exit the Select and then do a read that blocks until we get
-- something.  It then uses the Notify_Task to tell Xt that it has done
-- something.
------------------------------------------------------------------------------
        Our_Connection : Connection_Id;
        Notify_Task    : Notify_Complete;
        Queue_Count    : X_Raw_Data_Index := 0;
        Queue_Buffer   : X_Raw_Data_Array (1 .. 1);
        Tmp_Count      : X_Raw_Data_Index;
        Tmp_Status     : Status_Code;
    begin

----Wait for our initialize call.  We don't really exist until we get it.

        select
            accept Initialize (Connection : Connection_Id) do
                Our_Connection       := Connection;
                Our_Connection.State := Pending_Read_None;
            end Initialize;
        or
            terminate;
        end select;

----Loop until we get aborted or until the program exits.

        loop
            while Notify_Task = None_Notify_Complete loop

------------------------------------------------------------------------------
-- Receive_Mabe entry - try a read; if it fails then just return
------------------------------------------------------------------------------

                select
                    accept Receive_Maybe (Status : out    Status_Code;
                                          Data   : in out X_Raw_Data_Array;
                                          Count  : out    X_Raw_Data_Index) do

                        if Queue_Count > 0 then
                            Data (Data'First) := Queue_Buffer (1);
                            Queue_Count       := 0;
                            Transport.Receive
                               (Connection => Our_Connection.Connection,
                                Status => Status,
                                Data => Data (Data'First + 1 .. Data'Last),
                                Count => Tmp_Count,
                                Max_Wait => 0.0);
                            Count := Tmp_Count + 1;
                            return;
                        else
                            Transport.Receive
                               (Connection => Our_Connection.Connection,
                                Status     => Status,
                                Data       => Data,
                                Count      => Count,
                                Max_Wait   => 0.0);
                            return;
                        end if;

                    end Receive_Maybe;

------------------------------------------------------------------------------
-- Receive_Queue entry - try to read; if that fails then queue a read
------------------------------------------------------------------------------

                or
                    accept Receive_Queue (Status : out    Status_Code;
                                          Data   : in out X_Raw_Data_Array;
                                          Count  : out    X_Raw_Data_Index;
                                          Notify :        Notify_Complete) do

                        if Queue_Count > 0 then
                            Data (Data'First) := Queue_Buffer (1);
                            Queue_Count       := 0;
                            Transport.Receive
                               (Connection => Our_Connection.Connection,
                                Status => Status,
                                Data => Data (Data'First + 1 .. Data'Last),
                                Count => Tmp_Count,
                                Max_Wait => 0.0);
                            Count := Tmp_Count + 1;
                            return;
                        else
                            Transport.Receive
                               (Connection => Our_Connection.Connection,
                                Status     => Tmp_Status,
                                Data       => Data,
                                Count      => Tmp_Count,
                                Max_Wait   => 0.0);

                            Status := Tmp_Status;
                            Count  := Tmp_Count;
                            if Tmp_Count > 0 or else
                               (Tmp_Status /= Transport_Defs.Ok and then
                                Tmp_Status /= Transport_Defs.Timed_Out) then
                                return;
                            end if;

                            Notify_Task          := Notify;
                            Our_Connection.State := Pending_Read_Wait;
                        end if;

                    end Receive_Queue;

------------------------------------------------------------------------------
-- Receive_Must entry - we do not return until we get what we came for
------------------------------------------------------------------------------

                or
                    accept Receive_Must (Status : out    Status_Code;
                                         Data   : in out X_Raw_Data_Array;
                                         Count  : out    X_Raw_Data_Index) do
                        declare
                            Need_Count : constant X_Raw_Data_Index :=
                               Data'Length;
                            Total      : X_Raw_Data_Index;
                        begin

                            Tmp_Status := Transport_Defs.Ok;
                            if Queue_Count > 0 then
                                Data (Data'First) := Queue_Buffer (1);
                                Queue_Count       := 0;
                                Total             := 1;
                            else
                                Total := 0;
                            end if;

----If we got all we asked for then return to the caller.

                            loop
                                if Total = Need_Count or else
                                   Tmp_Status /= Transport_Defs.Ok then
                                    Status := Tmp_Status;
                                    Count  := Total;
                                    return;
                                end if;

----Receive what we can this time.

                                Transport.Receive
                                   (Connection => Our_Connection.Connection,
                                    Status     => Tmp_Status,
                                    Data       => Data (Data'First + Total ..
                                                           Data'Last),
                                    Count      => Tmp_Count,
                                    Max_Wait   => Duration'Last);
                                Total := Total + Tmp_Count;
                            end loop;

                        end;
                    end Receive_Must;

------------------------------------------------------------------------------
-- Terminate if necessary.
------------------------------------------------------------------------------

                or
                    terminate;
                end select;
            end loop;

----Do an initial receive.  See if we get what we wanted without further
--  effort.

            Transport.Receive (Connection => Our_Connection.Connection,
                               Status     => Tmp_Status,
                               Data       => Queue_Buffer,
                               Count      => Queue_Count,
                               Max_Wait   => Duration'Last);

----If we got it then return it all to the caller.  Set our state first and
--  then call the notify task afterwards.  Xt always checks the state first
--  and then does a rendezvous if it can't do anything else.  (Saves a trifle
--  of time.)

            Our_Connection.State := Pending_Read_Done;
            Notify_Task.Set_Done;
            if Tmp_Status /= Transport_Defs.Ok then
                Queue_Count := 0;
            end if;
            Notify_Task := None_Notify_Complete;
        end loop;

    end Connection_Reader;

--/ end if;

--\f

--/ if Multitask_Locking then
    task body X_Mutex_Rec is
------------------------------------------------------------------------------
-- Lock or Unlock the X_Library data structure.
------------------------------------------------------------------------------
    begin  
        loop

----We start out unlocked; so accept any Lock entry.

            select  
                accept Lock do  
                    null;  
                end Lock;  
            or  
                accept Unlock do
                    ----We aren't locked!?!?
                    raise X_Library_Confusion;  
                end Unlock;  
            or  
                accept Destroy_Self do  
                    return; -- Terminate the task.
                end Destroy_Self;  
            or  
                terminate;  
            end select;

----We are now locked; so accept any Unlock entry.

            select  
                accept Unlock do  
                    null;  
                end Unlock;  
            or  
                terminate;  
            end select;  
        end loop;

    end X_Mutex_Rec;

--/ end if;

--\f

    procedure Free_X_Mutex (M : in out X_Mutex) is  
    begin

--/ if not Multitask_Locking then
--//
--//        Heap_Free_X_Mutex (M);
--//
--/ else

        if M /= null then  
            M.Destroy_Self;  
            Heap_Free_X_Mutex (M);  
        end if;

--/ end if;

    end Free_X_Mutex;

--\f

    procedure Lock_Mutex (Mutex : X_Mutex) is  
    begin

--/ if not Multitask_Locking then
--//        if Mutex.Flop = 0 then
--//            Mutex.Flop := 1;
--//        else
--//            raise X_Library_Confusion;
--//        end if;
--/ else
        Mutex.Lock;
--/ end if;

    end Lock_Mutex;

--\f

    procedure Unlock_Mutex (Mutex : X_Mutex) is  
    begin

--/ if not Multitask_Locking then
--//        if Mutex.Flop = 1 then
--//            Mutex.Flop := 0;
--//        else
--//            raise X_Library_Confusion;
--//        end if;
--/ else
        Mutex.Unlock;
--/ end if;

    end Unlock_Mutex;

--\f

--/ if cdf_Hpux then
--//
--//     function Get_Errno return Status_Code is
--//         use System_Interface.Error;
--//         Err : Unix_Base_Types.Int := Errno;
--//     begin
--//
--//         if Err = Etimedout then
--//             return Status_Code (Ewouldblock);
--//         else
--//             return Status_Code (Err);
--//         end if;
--//
--//     end Get_Errno;
--//
--/ elsif TeleGen2 and then Unix then
--//
--//     function Get_Errno return Status_Code is
--//         use Error_Messages;
--//         Err : Errors := Errno;
--//     begin
--//
--//         if Err = Etimedout then
--//             return Status_Code (Error_Messages.Ewouldblock);
--//         else
--//             return Status_Code (Err);
--//         end if;
--//
--//     end Get_Errno;
--//
--/ end if;

--\f

    function Image (Code : Status_Code) return String is  
    begin
--/ if R1000 then
        return Transport_Defs.Image (Code);
--/ else
--//         return Status_Code'Image (Code);
--/ end if;
    end Image;


--\f

end Xlbmt_Network_Types;