|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 54218 (0xd3ca)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦059497ac5⟧
└─⟦this⟧
--/ 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;