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

⟦af2a9b2b8⟧ TextFile

    Length: 54218 (0xd3ca)
    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;  
with Transport_Name;
--/ elsif Cdf_Hpux then
--// with C_Library_Interface;
--// with System_Interface;
--// with Unix_Base_Types;
--/ elsif TeleGen2 and then Unix then
--// with Error_Messages;                   -- Unix errors
--/ end if;

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;  
with Xlbt_Basic;  
use Xlbt_Basic;  
with Xlbt_Display2;  
use Xlbt_Display2;  
with Xlbt_Error;  
use Xlbt_Error;  
with Xlbt_Event;  
use Xlbt_Event;  
with Xlbt_Event3;  
with Xlbt_Exceptions;  
use Xlbt_Exceptions;  
with Xlbt_Proc_Var;  
use Xlbt_Proc_Var;
with Xlbt_Request;
use Xlbt_Request;

with Xlbp_Error;  
use Xlbp_Error;  
with Xlbp_Proc_Var;  
use Xlbp_Proc_Var;

with Xlbit_Library3;  
use Xlbit_Library3;

with Xlbip_Internal;  
use Xlbip_Internal;  
with Xlbip_Wire_Converters;  
use Xlbip_Wire_Converters;

with Xlbmt_Network_Types;  
use Xlbmt_Network_Types;  
with Xlbmt_Transport_Defs;  
use Xlbmt_Transport_Defs;

with Xlbmp_Environment;  
use Xlbmp_Environment;  
with Xlbmp_Network_Interface;  
use Xlbmp_Network_Interface;

with Xlbit_Library2;        -- This is here to cause the linking and the
                            -- elaboration of the body of this package.
with Xlbmp_Debugger;        -- This is here to cause the linking and the
                            -- elaboration of the body of this package.
pragma Elaborate (Xlbmp_Debugger);

package body Xlbmp_Internal is
------------------------------------------------------------------------------
-- X Library Machine Dependent Internal Support
--
-- Xlbmp_Internal - Very low-level routines for internal X Library support
------------------------------------------------------------------------------
-- Copyright 1989 - 1991 by Rational, Santa Clara, California.
-- Copyright 1985 - 1989 by the Massachusetts Institute of Technology
--
--                  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 names of MIT or Rational not be
-- used in advertising or publicity pertaining to distribution of the software
-- without specific, written prior permission.
--
-- MIT and Rational disclaim all warranties with regard to this software,
-- including all implied warranties of merchantability and fitness, in no
-- event shall MIT or 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

--/ if R1000 then

    function "=" (A, B : Transport_Defs.Network_Name) return Boolean  
        renames Transport_Defs."=";

--/ end if;

    X_Tcp_Port : constant := 6000;      -- add display number to this
                                        -- Base X server socket/port number

    Unexp_Reply  : constant X_String :=  
       "Reply_Event received when not expected.  Out of sync?";  
    Unknown_Host : constant X_String := "Host name (or number) is unknown:";

------------------------------------------------------------------------------
-- Length of any Event/Error that we can receive from the X server.  They are
-- all the same size.
------------------------------------------------------------------------------

    Event_Length : constant X_Raw_Data_Index :=  
       Xlbt_Event3.X_Button_Event'Size / 8;

--\f

    function Internal_X_Events_Queued (Display : X_Display;  
                                       Mode : X_Event_Queuing) return S_Long is
------------------------------------------------------------------------------
-- Read in any pending events and return the number of queued events.
------------------------------------------------------------------------------
        Rec_Next    : X_Raw_Data_Index := 1;  
        Rec_Len     : X_Raw_Data_Index := 0;  
        New_Next_M1 : X_Raw_Data_Index;  
        Client_Sent : Boolean;  
        Code        : X_Event_Code;  
        Er          : X_Error_Contents;  
        Ev          : X_Event;  
        Queue_It    : X_Status;  
    begin

----If requested then we will flush first.

        if Mode = Queued_After_Flush then  
            Internal_X_Flush_Display (Display);  
            if Display.Q_Len > 0 then  
                return Display.Q_Len;  
            end if;  
        end if;

----If we have gotten an I/O error then don't do more I/O.

        if Display.Flags (Xlib_Display_Io_Error) then  
            return 0;  
        end if;

----If there is any pending input in Display.Input then put that into our buffer
--  and add new information to it.

        if Display.Input.Used < Display.Input.Data'Last then  
            Receive_Maybe  
               (Display.Network.Fd,  
                Display.Network.Fd_Error,  
                Display.Input.Data  
                   (Display.Input.Used + 1 .. Display.Input.Data'Last),  
                Rec_Len);  
            Display.Input.Used := Display.Input.Used + Rec_Len;

----See if our Receive had an error.  Timed_Out is fine; return if there's no
--  data to be had.

            if Display.Network.Fd_Error /= Ok and then  
               Display.Network.Fd_Error /= Timed_Out then  
                Report_Io_Error (Display, "Receive");  
            end if;  
            if Display.Input.Used = 0 then  
                return Display.Q_Len;  
            end if;  
        end if;

----Loop until we've used up all of the data in the buffer.

        while Rec_Next <= Display.Input.Used loop


----We assume here that all Event/Error packets are the same size.  This is
--  currently true.  X11.V1  1/6/88.  Calculate the end of the record.

            New_Next_M1 := Rec_Next + Event_Length - 1;

----If there isn't enough data in the buffer to make up the next record then
--  we'll read in some more data.  We watch carefully to make sure that we
--  don't overflow the buffer.

            if New_Next_M1 > Display.Input.Used then  
                if New_Next_M1 > Display.Input.Data'Last then  
                    New_Next_M1 := Display.Input.Used;  
                    Display.Input.Used := Display.Input.Used - Rec_Next + 1;  
                    Display.Input.Data (1 .. Display.Input.Used) :=  
                       Display.Input.Data (Rec_Next .. New_Next_M1);  
                    Rec_Next := 1;  
                    New_Next_M1 := Rec_Next + Event_Length - 1;  
                end if;  
                Receive_Maybe  
                   (Display.Network.Fd,  
                    Display.Network.Fd_Error,  
                    Display.Input.Data  
                       (Display.Input.Used + 1 .. Display.Input.Data'Last),  
                    Rec_Len);  
                Display.Input.Used := Display.Input.Used + Rec_Len;

----If we timed out and/or there still isn't enough data to process then save
--  the pending data in Display.Input and return.  Check for errors as well.

                if Display.Network.Fd_Error /= Ok and then  
                   Display.Network.Fd_Error /= Timed_Out then  
                    Report_Io_Error (Display, "Receive");  
                end if;  
                if New_Next_M1 > Display.Input.Used then  
                    if Rec_Next > 1 then  
                        New_Next_M1 := Display.Input.Used;  
                        Display.Input.Used := Display.Input.Used - Rec_Next + 1;  
                        Display.Input.Data (1 .. Display.Input.Used) :=  
                           Display.Input.Data (Rec_Next .. New_Next_M1);  
                    end if;  
                    return Display.Q_Len;  
                end if;

            end if;

----Take the next record and convert it appropriately.

--/ if Raw_Is_Unsigned then
            if Display.Input.Data (Rec_Next) > 127 then  
                Client_Sent := True;  
                Code := X_Event_Code'Val (Display.Input.Data (Rec_Next) - 128);  
            else  
                Client_Sent := False;  
                Code        := X_Event_Code'Val (Display.Input.Data (Rec_Next));  
            end if;
--/ else
--//            if Display.Input.Data (Rec_Next) < 0 then
--//                Client_Sent := True;
--//                Code        := X_Event_Code'Val
--//                                  ((Display.Input.Data (Rec_Next) + 127) + 1);
--//            else
--//                Client_Sent := False;
--//                Code        := X_Event_Code'Val (Display.Input.Data (Rec_Next));
--//            end if;
--/ end if;
            Display.Input.Data (Rec_Next) := X_Event_Code'Pos (Code);  
            case Code is

----Error are converted and immediately reported.

                when Error_Event =>  
                    Internal_Wire_To_Error  
                       (Display,  
                        Display.Input.Data (Rec_Next .. New_Next_M1),  
                        Client_Sent,  
                        Er);  
                    declare  
                        Proc : X_Procedure_Variable;  
                    begin  
                        X_Lib.Get_Error (Display, Proc);  
                        Proc_Var_X_Error_Function.Call  
                           (Proc_Var_X_Error_Function.To_Pv (Proc),  
                            Display, Er);  
                    end;

----Replies should not happen here.

                when Reply_Event =>
                    ----This isn't supposed to happen.  Replies are always
                    --  waited for; something is very wrong.
                    declare  
                        Proc : X_Procedure_Variable;  
                    begin  
                        X_Lib.Get_Io_Error (Display, Proc);  
                        Err (Display.Last_Error,  
                             X_Get_Error_String ("XlibError", "UnexpReply",  
                                                 Unexp_Reply));  
                        Proc_Var_X_Io_Error_Function.Call  
                           (Proc_Var_X_Io_Error_Function.To_Pv (Proc), Display);  
                        raise X_Network_Io_Error;
                    end;

----Everything else is assumed to be an Event.

                when others =>  
                    Proc_Var_X_Wire_Event.Call  
                       (Proc_Var_X_Wire_Event.To_Pv (Display.Event_Vec (Code)),  
                        Display,  
                        Display.Input.Data (Rec_Next .. New_Next_M1),  
                        Client_Sent,  
                        Ev,  
                        Queue_It);  
                    if Queue_It = Successful then  
                        Internal_X_Enq (Display, Ev);  
                    end if;  
            end case;  
            Rec_Next := New_Next_M1 + 1;  
        end loop;

----Can't read any more; return the present queue length.

        Display.Input.Used := 0;        -- Reset to zero since it's all used up.
        return Display.Q_Len;

    end Internal_X_Events_Queued;

--\f

    procedure Internal_X_Wait_For_Writable (Display : X_Display) is
------------------------------------------------------------------------------
-- This is an OS dependent routine which:
-- 1) returns as soon as the connection can be written on....
-- 2) if the connection can be read, must enqueue events and handle errors,
-- until the connection is writable.
-- NOTE: On the R1000 we cannot do this since there is no way to test for
-- "writability"; silly machine; what we do instead is read anything that is
-- available and return when we've used up everything that we can readily get.
------------------------------------------------------------------------------
        Rec_Next      : X_Raw_Data_Index := 1;  
        Rec_Len       : X_Raw_Data_Index := 0;  
        New_Next_M1   : X_Raw_Data_Index;  
        Client_Sent   : Boolean;  
        Code          : X_Event_Code;  
        Er            : X_Error_Contents;  
        Ev            : X_Event;  
        Queue_It      : X_Status;  
        Did_Something : Boolean          := False;  
    begin

----If there is any pending input in Display.Input then put that into our buffer
--  and add new information to it.

        if Display.Input.Used < Display.Input.Data'Last then  
            Receive_Maybe  
               (Display.Network.Fd,  
                Display.Network.Fd_Error,  
                Display.Input.Data  
                   (Display.Input.Used + 1 .. Display.Input.Data'Last),  
                Rec_Len);  
            Display.Input.Used := Display.Input.Used + Rec_Len;

----See if our Receive had an error.  Timed_Out is fine; return if there's no
--  data to be had.

            if Display.Network.Fd_Error /= Ok and then  
               Display.Network.Fd_Error /= Timed_Out then  
                Report_Io_Error (Display, "Receive");  
            end if;  
            if Display.Input.Used = 0 then  
                Did_Something := Rec_Len > 0;  
                goto All_Done;  
            end if;  
        end if;

----Loop until we've used up all of the data in the buffer.

        while Rec_Next <= Display.Input.Used loop


----We assume here that all Event/Error packets are the same size.  This is
--  currently true.  X11.V1  1/6/88.  Calculate the end of the record.

            New_Next_M1 := Rec_Next + Event_Length - 1;

----If there isn't enough data in the buffer to make up the next record then
--  we'll read in some more data.  We watch carefully to make sure that we
--  don't overflow the buffer.

            if New_Next_M1 > Display.Input.Used then  
                if New_Next_M1 > Display.Input.Data'Last then  
                    New_Next_M1 := Display.Input.Used;  
                    Display.Input.Used := Display.Input.Used - Rec_Next + 1;  
                    Display.Input.Data (1 .. Display.Input.Used) :=  
                       Display.Input.Data (Rec_Next .. New_Next_M1);  
                    Rec_Next := 1;  
                    New_Next_M1 := Event_Length;  
                end if;  
                Receive_Maybe  
                   (Display.Network.Fd,  
                    Display.Network.Fd_Error,  
                    Display.Input.Data  
                       (Display.Input.Used + 1 .. Display.Input.Data'Last),  
                    Rec_Len);  
                Display.Input.Used := Display.Input.Used + Rec_Len;

----If we timed out and/or there still isn't enough data to process then save
--  the pending data in Display.Input and return.  Check for errors as well.

                if Display.Network.Fd_Error /= Ok and then  
                   Display.Network.Fd_Error /= Timed_Out then  
                    Report_Io_Error (Display, "Receive");  
                end if;  
                if New_Next_M1 > Display.Input.Used then  
                    if Rec_Next > 1 then  
                        New_Next_M1 := Display.Input.Used;  
                        Display.Input.Used := Display.Input.Used - Rec_Next + 1;  
                        Display.Input.Data (1 .. Display.Input.Used) :=  
                           Display.Input.Data (Rec_Next .. New_Next_M1);  
                    end if;  
                    Did_Something := Did_Something or Rec_Len > 0;  
                    goto All_Done;  
                end if;  
            end if;

----Take the next record and convert it appropriately.

--/ if Raw_Is_Unsigned then
            if Display.Input.Data (Rec_Next) > 127 then  
                Client_Sent := True;  
                Code := X_Event_Code'Val (Display.Input.Data (Rec_Next) - 128);  
            else  
                Client_Sent := False;  
                Code        := X_Event_Code'Val (Display.Input.Data (Rec_Next));  
            end if;
--/ else
--//            if Display.Input.Data (Rec_Next) < 0 then
--//                Client_Sent := True;
--//                Code        := X_Event_Code'Val
--//                                  ((Display.Input.Data (Rec_Next) + 127) + 1);
--//            else
--//                Client_Sent := False;
--//                Code        := X_Event_Code'Val (Display.Input.Data (Rec_Next));
--//            end if;
--/ end if;
            Display.Input.Data (Rec_Next) := X_Event_Code'Pos (Code);  
            Did_Something                 := True;  
            case Code is

----Error are converted and immediately reported.

                when Error_Event =>  
                    Internal_Wire_To_Error  
                       (Display,  
                        Display.Input.Data (Rec_Next .. New_Next_M1),  
                        Client_Sent,  
                        Er);  
                    declare  
                        Proc : X_Procedure_Variable;  
                    begin  
                        X_Lib.Get_Error (Display, Proc);  
                        Proc_Var_X_Error_Function.Call  
                           (Proc_Var_X_Error_Function.To_Pv (Proc),  
                            Display, Er);  
                    end;

----Replies should not happen here.

                when Reply_Event =>
                    ----This isn't supposed to happen.  Replies are always
                    --  waited for; something is very wrong.
                    declare  
                        Proc : X_Procedure_Variable;  
                    begin  
                        X_Lib.Get_Io_Error (Display, Proc);  
                        Err (Display.Last_Error,  
                             X_Get_Error_String ("XlibError", "UnexpReply",  
                                                 Unexp_Reply));  
                        Proc_Var_X_Io_Error_Function.Call  
                           (Proc_Var_X_Io_Error_Function.To_Pv (Proc),  
                            Display);  
                        raise X_Network_Io_Error;
                    end;

----Everything else is assumed to be an Event.

                when others =>  
                    Proc_Var_X_Wire_Event.Call  
                       (Proc_Var_X_Wire_Event.To_Pv (Display.Event_Vec (Code)),  
                        Display,  
                        Display.Input.Data (Rec_Next .. New_Next_M1),  
                        Client_Sent,  
                        Ev,  
                        Queue_It);  
                    if Queue_It = Successful then  
                        Internal_X_Enq (Display, Ev);  
                    end if;  
            end case;  
            Rec_Next := New_Next_M1 + 1;  
        end loop;  
        Display.Input.Used := 0;        -- Reset to zero since data all used up.

----Come here when we are ready to return to our caller.  If we didn't really
--  do anything then we delay for a while so we aren't a busy-loop chewing up
--  the entire cpu.  (If some OS has an option to this then we do that.)

        <<All_Done>> null;
--/ if R1000 then
        if not Did_Something then  
            delay 0.25;  
        end if;
--/ elsif TeleGen2 and then Unix then
--//        declare
--//            Void  : S_Long;
--//            Fdset : S_Long := 2 ** Natural(Display.Network.Fd);
--//            Timer : Timeval := (Tv_Sec => 1, Tv_Usec => 0);
--//        begin
--//            Void := Unix_Select (S_Long(Display.Network.Fd),-- Only the one FD
--//                                 None_System_Address,-- Read is don't care
--//                                 Fdset'Address,      -- Check for writable
--//                                 Fdset'Address,      -- Check for except's
--//                                 Timer'Address);     -- Wait for 1 second
--//        end;
--/ else
--//        if not Did_Something then
--//            delay 0.5;
--//        end if;
--/ end if;

    end Internal_X_Wait_For_Writable;

--\f

    procedure Internal_X_Flush_Display (Display : X_Display) is
------------------------------------------------------------------------------
-- Flush the X request buffer.  If the buffer is empty, no action is taken.
-- If the entire write cannot be done without blocking then do partial writes
-- and read Error/Events in between.
------------------------------------------------------------------------------
        Amount : X_Raw_Data_Index;  
        Start  : X_Raw_Data_Index := 1;  
        Finish : X_Raw_Data_Index;  
    begin

----If we have gotten an I/O error then don't do more I/O.

        if Display.Flags (Xlib_Display_Io_Error) then  
            return;  
        end if;

----If there is a Last_Req that isn't in the output buffer yet then put it
--  there.  We know that it will fit in the remaining room.

        if Display.Last_Request.Kind /= Invalid_Request then  
            Internal_X_Flush_Last_Request (Display);  
        end if;

----Don't transmit zero data.

        Finish := Display.Output.Used;  
        if Finish = 0 then  
            return;  
        end if;

----Debug Printout

        -- Put ("Internal_X_Flush_Display");
        -- Put (S_Long (Finish));
        -- Put_Line (" bytes.");
        -- for I in Start .. Finish loop
        --     declare
        --         use Text_Io;
        --         use S_Long_Io;
        --         D1, D2 : X_Raw_Data_Index;
        --     begin
        --         D1 := X_Raw_Data_Index (Display.Output.Data (I)) / 16;
        --         D2 := X_Raw_Data_Index (Display.Output.Data (I)) rem 16;
        --         Put (' ');
        --         if D1 < 10 then
        --             Put (Character'Val (Character'Pos ('0') + D1));
        --         else
        --             Put (Character'Val (Character'Pos ('a') - 10 + D1));
        --         end if;
        --         if D2 < 10 then
        --             Put (Character'Val (Character'Pos ('0') + D2));
        --         else
        --             Put (Character'Val (Character'Pos ('a') - 10 + D2));
        --         end if;
        --     end;
        -- end loop;
        -- New_Line;

----Attempt a write.

        loop  
            Transmit_Maybe (Display.Network.Fd,  
                            Display.Network.Fd_Error,  
                            Display.Output.Data (Start .. Finish),  
                            Amount);

----See if we timed out; if so then read a while and try again.

            Start := Start + Amount;  
            if Start > Finish or else  
               (Display.Network.Fd_Error /= Timed_Out and then  
                Display.Network.Fd_Error /= Ok) then  
                exit;  
            end if;  
            Internal_X_Wait_For_Writable (Display);  
        end loop;

----If the write failed then we call the IO error function; he's not expected to
--  return.

        if Display.Network.Fd_Error /= Ok then  
            Report_Io_Error (Display, "Transmit");  
        end if;  
        Display.Output.Used := 0;

    end Internal_X_Flush_Display;

--\f

    procedure Internal_X_Read_Events (Display : X_Display) is
------------------------------------------------------------------------------
-- Don't return until we read and queue up at least one new event.  Just like
-- Internal_X_Events_Queued except that we don't return a count and we don't
-- return until we've read at least one.
------------------------------------------------------------------------------
        Rec_Next        : X_Raw_Data_Index := 1;  
        Rec_Len         : X_Raw_Data_Index := 0;  
        New_Next_M1     : X_Raw_Data_Index;  
        Client_Sent     : Boolean;  
        Code            : X_Event_Code;  
        Er              : X_Error_Contents;  
        Ev              : X_Event;  
        Orig_Q_Len      : S_Long           := Display.Q_Len;  
        Queue_It        : X_Status;  
        Not_Yet_Flushed : Boolean          := True;  
    begin

----If we have gotten an I/O error then don't do more I/O.

        if Display.Flags (Xlib_Display_Io_Error) then  
            return;  
        end if;

----If there is any pending input in Display.Input then put that into our buffer
--  and add new information to it.

        if Display.Input.Used < Display.Input.Data'Last then  
            Receive_Maybe  
               (Display.Network.Fd,  
                Display.Network.Fd_Error,  
                Display.Input.Data  
                   (Display.Input.Used + 1 .. Display.Input.Data'Last),  
                Rec_Len);  
            Display.Input.Used := Display.Input.Used + Rec_Len;

----See if our Receive had an error.  Timed_Out is fine; we'll fix that below.

            if Display.Network.Fd_Error /= Ok and then  
               Display.Network.Fd_Error /= Timed_Out then  
                Report_Io_Error (Display, "Receive");  
            end if;  
        end if;

----Loop until we've used up all of the data in the buffer.

        while Display.Q_Len = Orig_Q_Len loop


----We assume here that all Event/Error packets are the same size.  This is
--  currently true.  X11.V1  1/6/88.  Calculate the end of the record.

            New_Next_M1 := Rec_Next + Event_Length - 1;

----If there isn't enough data in the buffer to make up the next record then
--  we'll read in some more data.  We watch carefully to make sure that we
--  don't overflow the buffer.

            if New_Next_M1 > Display.Input.Used then  
                if New_Next_M1 > Display.Input.Data'Last then  
                    New_Next_M1 := Display.Input.Used;  
                    Display.Input.Used := Display.Input.Used - Rec_Next + 1;  
                    Display.Input.Data (1 .. Display.Input.Used) :=  
                       Display.Input.Data (Rec_Next .. New_Next_M1);  
                    Rec_Next := 1;  
                    New_Next_M1 := Event_Length;  
                end if;  
                if Not_Yet_Flushed then  
                    Internal_X_Flush_Display (Display);  
                    if Orig_Q_Len /= Display.Q_Len then  
                        return;  
                    end if;  
                    Not_Yet_Flushed := False;  
                end if;  
                Receive_Maybe  
                   (Display.Network.Fd,  
                    Display.Network.Fd_Error,  
                    Display.Input.Data  
                       (Display.Input.Used + 1 .. Display.Input.Data'Last),  
                    Rec_Len);  
                Display.Input.Used := Display.Input.Used + Rec_Len;

----If we timed out and there still isn't enough data to process then if we have
--  a new event then save the pending data in Display.Input and return;
--  otherwise we wait forever for more data.  Check for errors as well.

                if Display.Network.Fd_Error /= Ok and then  
                   Display.Network.Fd_Error /= Timed_Out then  
                    Report_Io_Error (Display, "Receive");  
                end if;  
                if New_Next_M1 > Display.Input.Used then  
                    if Display.Q_Len > Orig_Q_Len then  
                        if Rec_Next > 1 then  
                            New_Next_M1 := Display.Input.Used;  
                            Display.Input.Used :=  
                               Display.Input.Used - Rec_Next + 1;  
                            Display.Input.Data (1 .. Display.Input.Used) :=  
                               Display.Input.Data (Rec_Next .. New_Next_M1);  
                        end if;  
                        return;  
                    end if;  
                    Receive_Must (Display.Network.Fd,  
                                  Display.Network.Fd_Error,  
                                  Display.Input.Data  
                                     (Display.Input.Used + 1 .. New_Next_M1),  
                                  Rec_Len);  
                    Display.Input.Used := Display.Input.Used + Rec_Len;  
                    if Display.Network.Fd_Error /= Ok then  
                        Report_Io_Error (Display, "Receive");  
                    end if;  
                end if;  
            end if;

----Take the next record and convert it appropriately.

--/ if Raw_Is_Unsigned then
            if Display.Input.Data (Rec_Next) > 127 then  
                Client_Sent := True;  
                Code := X_Event_Code'Val (Display.Input.Data (Rec_Next) - 128);  
            else  
                Client_Sent := False;  
                Code        := X_Event_Code'Val (Display.Input.Data (Rec_Next));  
            end if;
--/ else
--//            if Display.Input.Data (Rec_Next) < 0 then
--//                Client_Sent := True;
--//                Code        := X_Event_Code'Val
--//                                  ((Display.Input.Data (Rec_Next) + 127) + 1);
--//            else
--//                Client_Sent := False;
--//                Code        := X_Event_Code'Val (Display.Input.Data (Rec_Next));
--//            end if;
--/ end if;
            Display.Input.Data (Rec_Next) := X_Event_Code'Pos (Code);  
            case Code is

----Errors are converted and immediately reported.

                when Error_Event =>  
                    Internal_Wire_To_Error  
                       (Display,  
                        Display.Input.Data (Rec_Next .. New_Next_M1),  
                        Client_Sent,  
                        Er);  
                    declare  
                        Proc : X_Procedure_Variable;  
                    begin  
                        X_Lib.Get_Error (Display, Proc);  
                        Proc_Var_X_Error_Function.Call  
                           (Proc_Var_X_Error_Function.To_Pv (Proc),  
                            Display, Er);  
                    end;

----Replies should not happen here.

                when Reply_Event =>
                    ----This isn't supposed to happen.  Replies are always
                    --  waited for; something is very wrong.
                    declare  
                        Proc : X_Procedure_Variable;  
                    begin  
                        X_Lib.Get_Io_Error (Display, Proc);  
                        Err (Display.Last_Error,  
                             X_Get_Error_String ("XlibError", "UnexpReply",  
                                                 Unexp_Reply));  
                        Proc_Var_X_Io_Error_Function.Call  
                           (Proc_Var_X_Io_Error_Function.To_Pv (Proc), Display);  
                        raise X_Network_Io_Error;
                    end;

----Everything else is assumed to be an Event.

                when others =>  
                    Proc_Var_X_Wire_Event.Call  
                       (Proc_Var_X_Wire_Event.To_Pv (Display.Event_Vec (Code)),  
                        Display,  
                        Display.Input.Data (Rec_Next .. New_Next_M1),  
                        Client_Sent,  
                        Ev,  
                        Queue_It);  
                    if Queue_It = Successful then  
                        Internal_X_Enq (Display, Ev);  
                    end if;  
            end case;  
            Rec_Next := New_Next_M1 + 1;  
        end loop;

----Can't read any more.  Save whatever's left of the Input and return.

        if New_Next_M1 = Display.Input.Used then  
            Display.Input.Used := 0;  
        else  
            Rec_Next := Display.Input.Used;  
            Display.Input.Used := Display.Input.Used - New_Next_M1;  
            Display.Input.Data (1 .. Display.Input.Used) :=  
               Display.Input.Data (New_Next_M1 + 1 .. Rec_Next);  
        end if;

    end Internal_X_Read_Events;

--\f

--/ if R1000 then

    procedure Make_Host_Connection  
                 (Host        :        X_String;  
                  Display_Num :        U_Char;  
                  Connection  : in out Connection_Id;  
                  Host_Addr   : out    X_Network_Host_Address;  
                  Status      : out    X_Status;  
                  Error       : in out X_Error_String) is
------------------------------------------------------------------------------
-- Given a non-empty host name string and a display number; do the network
-- stuff necessary to locate that host on the network; open a socket to that
-- host; and connect to the proper X server on that host.  When we return we
-- have an open network connection that has as-yet transmitted nothing in
-- either direction.
------------------------------------------------------------------------------
--/ if R1000_Xlib_Only then
--//         Fd       : Connection_Id;
--/ else
        Fd      : Transport.Connection_Id;  
        Fd_Conn : Connection_Id;
--/ end if;
        Fd_Error     : Status_Code;  
        Socket       : S_Natural := X_Tcp_Port + S_Natural (Display_Num);  
        Host_Address : X_Network_Host_Address;  
    begin

----Determine what network this host is on and get his host ID.

        begin
            declare  
                Network_Id : constant Transport_Defs.Network_Name :=  
                   Transport_Name.Host_To_Network_Name (To_String (Host));  
                Host_Num   : constant Host_Id                     :=  
                   Transport_Name.Host_To_Host_Id (To_String (Host));  
            begin

----If he isn't on TCP/IP then we don't currently support him as we don't know
--  how to create his Socket_Id.

                if Network_Id /= "TCP/IP" then  
                    Err (Error,  
                         X_Get_Error_String  
                            ("XlibError", "OnlyTCPIP",  
                             "Only TCP/IP is currently supported."));  
                    Status := Failed;  
                    return;  
                end if;

----Open up a socket on his network.

                Transport.Open (Fd, Fd_Error, Network_Id);  
                if Fd_Error /= Ok then  
                    Err (Error, X_Get_Error_String
                                   ("XlibError", "TOpenFailed",  
                                    "Transport.Open call failed:") &  
                                ' ' & To_X_String (Image (Fd_Error)));  
                    Status := Failed;  
                    return;  
                end if;

----Now try to connect our socket to his socket.

                Transport.Connect
                   (Fd, Fd_Error, Host_Num,  
                    (0 => X_Raw_Data ((Socket / 2 ** 8) rem 2 ** 8),  
                     1 => X_Raw_Data (Socket rem 2 ** 8)));  
                if Fd_Error /= Ok then  
                    Transport.Close (Fd);  
                    Err (Error, X_Get_Error_String  
                                   ("XlibError", "TConnectFailed",  
                                    "Transport.Connect call failed:") &  
                                ' ' & To_X_String (Image (Fd_Error)));  
                    Status := Failed;  
                    return;  
                end if;

----We made it.  Return the open connection.

                Host_Address := new Host_Id'(Host_Num);
--/ if R1000_Xlib_Only then
--//             Connection := Fd;
--/ else
                Fd_Conn            := new Connection_Id_Rec;  
                Fd_Conn.Connection := Fd;  
                Fd_Conn.Reader.Initialize (Fd_Conn);  
                Connection := Fd_Conn;
--/ end if;
                Host_Addr := Host_Address;  
                Status    := Successful;  
                return;

            end;
        exception

            when Transport_Name.Undefined =>  
                Err (Error, X_Get_Error_String ("XlibError", "UndefHost",  
                                                "Host is undefined:") &  
                            ' ' & Host);  
                Status := Failed;  
                return;

            when others =>  
                Free_X_Network_Host_Address (Host_Address);
--/ if R1000_Xlib_Only then
--//                 Transport.Disconnect (Fd);
--//                 Transport.Close (Fd);
--/ else
                abort Fd_Conn.Reader;  
                Transport.Disconnect (Fd_Conn.Connection);  
                Transport.Close (Fd_Conn.Connection);  
                Free_Connection_Id (Fd_Conn);
--/ end if;
                raise;

        end;

    end Make_Host_Connection;

--/ end if; -- R1000

--\f

--/ if Unix then
--//
--//     procedure Make_Host_Connection (Host        :        X_String;
--//                                     Display_Num :        U_Char;
--//                                     Connection  : in out Connection_Id;
--//                                     Host_Addr   : out    X_Network_Host_Address;
--//                                     Status      : out    X_Status;
--//                                     Error       : in out X_Error_String) is
--// ------------------------------------------------------------------------------
--// -- Given a non-empty host name string and a display number; do the network
--// -- stuff necessary to locate that host on the network; open a socket to that
--// -- host; and connect to the proper X server on that host.  When we return we
--// -- have an open network connection that has as-yet transmitted nothing in
--// -- either direction.
--// ------------------------------------------------------------------------------
--//         Host_Asciz : String (1 .. Host'Length + 1) :=
--//            To_String (Host) & Ascii.Nul;
--//         Fd         : Connection_Id;
--//         Void       : S_Long;
--//         Socket_No  : S_Natural := X_Tcp_Port + S_Natural (Display_Num);
--//         Host_Num   : Host_Id;
--//         Hostentptr : Hostent_Pointer;
--//         Sock       : Sockaddr_In;
--//     begin
--//
--// ----Get the host's id number.  Host might be a number ("123.4.56.32") or it
--// --  might be a name.
--//
--//         if Host (Host'First) in '0' .. '9' then
--//             ----Try for a number.
--//             Host_Num := Inet_Addr (Host_Asciz (1)'Address);
--//             if Host_Num /= -1 then
--//                 goto Have_Host_Num;
--//             end if;
--//         end if;
--//         ----Try for a name.
--//         if Host = "" or else Host = "unix" or else Host = "UNIX" then
--//             Make_Host_Connection (Host        => X_Env_Get_Host_Name,
--//                                   Display_Num => Display_Num,
--//                                   Connection  => Connection,
--//                                   Host_Addr   => Host_Addr,
--//                                   Status      => Status,
--//                                   Error       => Error);
--//             return;
--//
--//         end if;
--//         Hostentptr := Get_Host_By_Name (Host_Asciz (1)'Address);
--//         if Hostentptr = null then
--//             Err (Error, X_Get_Error_String
--//                            ("XlibError", "UnknownHost", Unknown_Host) &
--//                         ' ' & Host);
--//             Status := Failed;
--//             return;
--//         end if;
--//         Host_Num := Hostentptr.H_Addr_List.all.A;
--//         <<Have_Host_Num>> null;
--//
--// ----Finish creating the socket description information.
--//
--//         Sock.Sin_Family      := S_Short (Hostentptr.H_Addrtype);
--//         Sock.Sin_Port        := U_Short (Socket_No);
--//         Sock.Sin_Addr.S_Addr := Host_Num;
--//         Sock.Sin_Zero        := (others => 0);
--//
--// ----Obtain a socket to use.
--//
--//         Fd := Socket (S_Long (Sock.Sin_Family), Sock_Stream, 0);
--//         if Fd < 0 then
--//             Err (Error, X_Get_Error_String ("XlibError", "CannotSocket",
--//                                             "Cannot allocate network socket:") &
--//                         ' ' & To_X_String
--/ if Cdf_Hpux then
--//                                  (Unix_Base_Types.To_String
--//                                      (C_Library_Interface.Error.Strerror
--//                                          (System_Interface.Error.Errno))));
--/ elsif TeleGen2 and then Unix then
--//                                  (Error_Messages.Sys_Error_Message
--//                                      (Error_Messages.Errno)));
--/ else
--//                                  (Need_Errno_String));
--/ end if;
--//             Status := Failed;
--//             return;
--//         end if;
--//
--// ----Now try to connect our socket to the X server's socket.
--//
--//         if Connect (Fd, Sock'Address, Sock'Size / 8) < 0 then
--//             Void := Close (Fd);
--//             Err (Error, X_Get_Error_String ("XlibError", "ConnectFailed",
--//                                             "System Connect call failed:") &
--//                         ' ' & To_X_String
--/ if Cdf_Hpux then
--//                                  (Unix_Base_Types.To_String
--//                                      (C_Library_Interface.Error.Strerror
--//                                          (System_Interface.Error.Errno))));
--/ elsif TeleGen2 and then Unix then
--//                                  (Error_Messages.Sys_Error_Message
--//                                      (Error_Messages.Errno)));
--/ else
--//                                  (Need_Errno_String));
--/ end if;
--//             Status := Failed;
--//             return;
--//         end if;
--//
--// ----We made it.  Return the open connection.
--//
--//         Host_Addr  := new Host_Id'(Host_Num);
--//         Connection := Fd;
--//         Status     := Successful;
--//         return;
--//
--//     end Make_Host_Connection;
--//
--/ end if; -- TeleGen2 and then Unix

--\f

    procedure Internal_X_Connect_Display  
                 (Display_Name  :        X_String;  
                  Expanded_Name : out    X_String_Pointer;  
                  Display_Num   : out    U_Char;  
                  Screen_Num    : out    X_Screen_Number;  
                  Family        : out    X_Host_Protocol_Family;  
                  Server_Addr   : out    X_Network_Host_Address;  
                  Connection    : out    X_Network_Connection;  
                  Status        : out    X_Status;  
                  Error         : in out X_Error_String) is
------------------------------------------------------------------------------
--  Display_Name    - Specifies what machine/screen/number to connect to
--  Expanded_Name   - Receives the full specification of the connection made
--                      or None_X_String_Pointer on errors
--  Display_Num     - Receives the display number of the connection
--  Screen_Num      - Receives the screen number of the connection
--  Family          - Receives the network family type of the connection
--  Status          - Receives an indication of the success/failure
--  Error           - Receives a string indicating any failure
--
-- Attempts to connect to server, given display name. Returns network connection
-- id.  Status = Failed if connection fails.  The expanded display name
-- of the form hostname:number.scr ("::" if DECnet) is returned in a result
-- parameter. The screen number to use is also returned.
-- The Display_Name may be of the following format:
--
--     [hostname] : [:] displaynumber [.screennumber]
--
-- The second colon indicates a DECnet style name.  No hostname is interpreted
-- as the most efficient local connection to a server on the same machine.
-- This is usually:
--
--     -  shared memory
--     -  local stream
--     -  UNIX domain socket
--     -  TCP to local host
------------------------------------------------------------------------------

        Host_First : S_Natural;                -- Start of host name
        Host_Last  : S_Natural;                -- End of host name
        First      : S_Natural;                -- Used in string searching
        Last       : S_Long;                   -- Used in string searching
        Current    : S_Long;                   -- Used in string searching
        Decnet     : Boolean;  
        Fd         : Connection_Id;            -- Network connection
--/ if Cdf_Hpux then
--//         Void : S_Long;
--/ elsif TeleGen2 and then Unix then
--//         Void : S_Long;
--/ end if;
        Ldisplay_Num : U_Char;                   -- Display number
        Scn_Num      : X_Screen_Number;          -- Screen number
        Lserver_Addr : X_Network_Host_Address;  
        Succ         : X_Status;

        procedure Search (Skip : X_Character; Want : X_Character) is  
        begin
            ----If we've used up the entire string then set First..Last to empty.
            if Current >= Display_Name'Last then  
                Last  := Display_Name'Last;  
                First := Last + 1;  
                return;  
            end if;
            ----Skip over Skip characters; watch for end of string.
            Current := Current + 1;  
            while Display_Name (Current) = Skip loop  
                if Current >= Display_Name'Last then  
                    Last := First - 1;  
                    return;  
                end if;  
                Current := Current + 1;  
            end loop;
            ----Scan remainder of string looking for the Want character.
            First := Current;  
            Last  := Display_Name'Last;  
            for I in First .. Last loop  
                if Display_Name (I) = Want then
                    ----Remember where we left off.
                    Current := I;  
                    Last    := I - 1;  
                    return;  
                end if;  
            end loop;
            ----Remember that string is now all used up.
            Current := Display_Name'Last;  
        end Search;

    begin

----Init our OUT parameters.

        Expanded_Name       := None_X_String_Pointer;  
        Display_Num         := 0;  
        Screen_Num          := 0;  
        Family              := None_X_Host_Protocol_Family;  
        Connection.Fd       := None_Connection_Id;  
        Connection.Fd_Error := Ok;  
        Server_Addr         := None_X_Network_Host_Address;  
        Err (Error, "");

----Locate the host name in our Display_Name string.  The string looks like this
--      [ host ] [ : ]+ [ display ] [ . [ screen ] ]
--  "[]" indicate optional parts; "[]+" indicates one or more occurrences of
--  "host" is anything that isn't a ":" and is valid as a host name
--  "display" is a decimal number
--  "screen" is a decimal number

        Current := Display_Name'First - 1;  
        Search (' ', ':');  
        Host_First := First;  
        Host_Last  := Last;

----We don't support DECnet on R1000's; at least not yet.

        Decnet := Current + 1 <= Display_Name'Last and then  
                     Display_Name (Current .. Current + 1) = "::";  
        Family := Family_Internet;  
        if Decnet then  
            Err (Error, X_Get_Error_String  
                           ("XlibError", "DECnetUnsup",  
                            "DECnet connections are not currently supported:") &  
                        ' ' & Display_Name);  
            Status := Failed;  
            return;  
        end if;

----Now locate the display number.  It follows the host name which was
--  terminated by a ":" if the display number is specified.

        Search (':', '.');  
        if First > Last then        -- If no display number given
            Ldisplay_Num := 0;           -- No display given; use default.
        else  
            begin  
                Ldisplay_Num := U_Char'Value  
                                   (To_String (Display_Name (First .. Last)));  
            exception  
                when Constraint_Error =>  
                    Err (Error, X_Get_Error_String  
                                   ("XlibError", "CEDpyNum",  
                                    "Constraint_Error raised while " &  
                                       "converting display number:") &  
                                ' ' & Display_Name (First .. Last));  
                    Status := Failed;  
                    return;  
            end;  
        end if;  
        Display_Num := Ldisplay_Num;

----Now locate the screen number.  It follows the display number which was
--  terminated by a "." if the screen number is specified.

        Search ('.', Nul);  
        if First > Last then        -- If no screen number given
            Scn_Num := 0;        -- No screen given; use default.
        else  
            begin  
                Scn_Num := X_Screen_Number'Value  
                              (To_String (Display_Name (First .. Last)));  
            exception  
                when Constraint_Error =>  
                    Err (Error, X_Get_Error_String  
                                   ("XlibError", "CEScrNum",  
                                    "Constraint_Error raised while " &  
                                       "converting screen number:") &  
                                ' ' & Display_Name (First .. Last));  
                    Status := Failed;  
                    return;  
            end;  
        end if;  
        Screen_Num := Scn_Num;

----Watch for junque.

        if Last < Display_Name'Last and then  
           Display_Name (Last + 1 .. Display_Name'Last) /=  
              (Last + 1 .. Display_Name'Last => Nul) and then  
           Display_Name (Last + 1 .. Display_Name'Last) /=  
              (Last + 1 .. Display_Name'Last => ' ') then  
            Err (Error,  
                 X_Get_Error_String  
                    ("XlibError", "DNGarbage",  
                     "Garbage characters after the display name :") & " [" &  
                 Display_Name (Last + 1 .. Display_Name'Last) & "]");  
            Status := Failed;  
            return;  
        end if;

----Try to open a socket onto the network of the host.  We connect to ourselves
--  if no host name was specified.

        if Host_First > Host_Last or else   -- If no host name given.
           Display_Name (Host_First .. Host_Last) = "local" then  
            begin  
                declare                     -- No host given; use local host
                    Host : constant X_String := X_Env_Get_Host_Name;  
                begin  
                    Make_Host_Connection (Host, Ldisplay_Num, Fd,  
                                          Lserver_Addr, Succ, Error);  
                end;  
            exception
--/ if R1000 then
                when Transport_Name.Undefined =>  
                    Err (Error, X_Get_Error_String  
                                   ("XlibError", "UnknownHost", Unknown_Host) &  
                                ' ' & Display_Name (Host_First .. Host_Last));  
                    Status := Failed;  
                    return;
--/ end if;
                when others =>  
                    raise;  
            end;  
        else                                -- Use his explicit host name
            Make_Host_Connection (Display_Name (Host_First .. Host_Last),  
                                  Ldisplay_Num, Fd, Lserver_Addr, Succ, Error);  
        end if;

----Make sure that we have a network connection.

        if Succ = Failed then  
            Free_X_Network_Host_Address (Lserver_Addr);  
            Status := Failed;  
            return;         -- Reason for failure already in Error.
        end if;

----Return the connection id string if the connection succeeded. Rebuild the
--  expanded id and return it.

        declare  
            Dn : constant String := U_Char'Image (Ldisplay_Num);  
            Sn : constant String := S_Natural'Image  
                                       (X_Screen_Number'Pos (Scn_Num));  
        begin  
            Expanded_Name :=  
               new X_String'(Display_Name (Host_First .. Host_Last) &  
                             ':' & To_X_String (Dn (Dn'First + 1 .. Dn'Last)) &  
                             '.' & To_X_String (Sn (Sn'First + 1 .. Sn'Last)));  
        exception  
            when others =>  
                Free_X_Network_Host_Address (Lserver_Addr);
--/ if R1000 and R1000_Xlib_Only then
--//                 Transport.Disconnect (Fd);
--//                 Transport.Close (Fd);
--/ elsif R1000 and not R1000_Xlib_Only then
                abort Fd.Reader;  
                Transport.Disconnect (Fd.Connection);  
                Transport.Close (Fd.Connection);  
                Free_Connection_Id (Fd);
--/ elsif Unix then
--//                 Void := Close (Fd);
--/ else
--//            Something;
--/ end if;
                raise;  
        end;  
        Server_Addr   := Lserver_Addr;  
        Connection.Fd := Fd;  
        Status        := Successful;

    end Internal_X_Connect_Display;

--\f

    procedure Internal_X_Disconnect_Display  
                 (Connection : in out X_Network_Connection) is
------------------------------------------------------------------------------
-- Disconnect from server.
------------------------------------------------------------------------------
--/ if R1000 and R1000_Xlib_Only then
--//     begin
--//
--//         Transport.Disconnect (Connection.Fd);
--//         Transport.Close (Connection.Fd);
--/ elsif R1000 and not R1000_Xlib_Only then
    begin

        if Connection.Fd /= null then  
            abort Connection.Fd.Reader;  
            Transport.Disconnect (Connection.Fd.Connection);  
            Transport.Close (Connection.Fd.Connection);  
            Free_Connection_Id (Connection.Fd);  
        end if;
--/ else
--//         Void : S_Long;
--//     begin
--//
--//         Void := Close (Connection.Fd);
--/ end if;

    end Internal_X_Disconnect_Display;

--\f

begin

----Register debugging "junque".  Xlbmp_Internal is, of necessity, used by any
--  interesting Xlib program.  Without Xlbmp_Internal you can't talk to the
--  X Server so you can't be "interesting".  So, register the debugging imagers
--  here.  This guarantees that this code isn't "forgotten" by some application
--  and it will make debugging easier for them.

    Xlbmp_Debugger.Register_Debugging_Imagers;

end Xlbmp_Internal;