|
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: 42258 (0xa512)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦059497ac5⟧
└─⟦this⟧
--/ if R1000 or Cdf_Hpux then
with Debug_Tools;
--/ end if;
--/ if R1000 then
with Transport;
with Transport_Defs;
--/ end if;
with Xlbt_Arithmetic;
use Xlbt_Arithmetic;
with Xlbt_Basic3;
use Xlbt_Basic3;
with Xlbt_Color;
use Xlbt_Color;
with Xlbt_Event2;
use Xlbt_Event2;
with Xlbt_Font3;
use Xlbt_Font3;
with Xlbt_Gc;
use Xlbt_Gc;
with Xlbt_Geometry;
use Xlbt_Geometry;
with Xlbt_Hint3;
use Xlbt_Hint3;
with Xlbt_Key3;
use Xlbt_Key3;
with Xlbt_Keyboard3;
use Xlbt_Keyboard3;
with Xlbt_Proc_Var;
use Xlbt_Proc_Var;
with Xlbt_Rm;
use Xlbt_Rm;
with Xlbt_String;
use Xlbt_String;
with Xlbt_Visual3;
use Xlbt_Visual3;
with Xlbt_Window4;
use Xlbt_Window4;
with Xlbp_Rm_Quark;
use Xlbp_Rm_Quark;
with Xlbmt_Network_Types;
use Xlbmt_Network_Types;
package body Xlbmp_Debugger is
------------------------------------------------------------------------------
-- X Library Machine Dependent Debugger Support
--
-- Xlbmp_Debugger - Some debuggers have special facilities that can be
-- set up for convenience in debugging. Do whatever may be necessary to
-- set things up.
------------------------------------------------------------------------------
-- Copyright 1989 - 1991 by Rational, Santa Clara, California.
--
-- All Rights Reserved.
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright notice(s) appear in all copies and that
-- both that copyright notice(s) and this permission notice appear in
-- supporting documentation, and that the name of Rational not be used in
-- advertising or publicity pertaining to distribution of the software
-- without specific, written prior permission.
--
-- Rational disclaims all warranties with regard to this software, including
-- all implied warranties of merchantability and fitness, in no event shall
-- Rational be liable for any special, indirect or consequential damages or
-- any damages whatsoever resulting from loss of use, data or profits, whether
-- in an action of contract, negligence or other tortious action, arising out
-- of or in connection with the use or performance of this software.
------------------------------------------------------------------------------
--/ if R1000 or Cdf_Hpux then
--\f
------------------------------------------------------------------------------
-- Variable_String - a crude variable length string type
------------------------------------------------------------------------------
type Variable_String (Max_Length : Natural) is
record
Length : Natural := 0;
Str : String (1 .. Max_Length);
end record;
Max_Line : constant := 78;
--\f
function Image (Str : Variable_String) return String is
begin
return Str.Str (1 .. Str.Length);
end Image;
--\f
procedure Append (Str : in out Variable_String;
Chr : Character) is
------------------------------------------------------------------------------
-- Str - Specifies the string to modify
-- Chr - Specifies the character to append
--
-- Called to append a character onto the end of a variable string.
------------------------------------------------------------------------------
begin
if Str.Length = Str.Max_Length then
return;
end if;
Str.Length := Str.Length + 1;
Str.Str (Str.Length) := Chr;
end Append;
--\f
procedure Append (Str : in out Variable_String;
Val : String) is
------------------------------------------------------------------------------
-- Str - Specifies the string to modify
-- Chr - Specifies the character to append
--
-- Called to append a string onto the end of a variable string.
------------------------------------------------------------------------------
begin
if Str.Length + Val'Length > Str.Str'Last then
Append
(Str,
Val (Val'First .. Val'First - 1 + Str.Max_Length - Str.Length));
return;
end if;
Str.Str (Str.Length + 1 .. Str.Length + Val'Length) := Val;
Str.Length := Str.Length + Val'Length;
end Append;
--\f
procedure Add (What : String;
Result : in out Variable_String;
Last_Crlf : in out Natural;
Prefix : String) is
------------------------------------------------------------------------------
-- What - Specifies a string to add to the Result
-- Result - Specifies our accumulated output
-- Last_Crlf - Specifies the last crlf that we did
-- Prefix - Specifies a new-line prefix string to use
--
-- Called to append a character onto the end of our output string.
------------------------------------------------------------------------------
begin
if Last_Crlf + What'Length > Max_Line then
Append (Result, Ascii.Lf);
Append (Result, Prefix);
Last_Crlf := Prefix'Length;
end if;
Append (Result, What);
Last_Crlf := Last_Crlf + What'Length;
end Add;
--\f
function Image_X_Atom (Value : X_Atom;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return the name of predefined atoms and something "intelligent" for others.
------------------------------------------------------------------------------
begin
case Value.Number is
when 1 =>
return "PRIMARY";
when 2 =>
return "SECONDARY";
when 3 =>
return "ARC";
when 4 =>
return "ATOM";
when 5 =>
return "BITMAP";
when 6 =>
return "CARDINAL";
when 7 =>
return "COLORMAP";
when 8 =>
return "CURSOR";
when 9 =>
return "CUT_BUFFER0";
when 10 =>
return "CUT_BUFFER1";
when 11 =>
return "CUT_BUFFER2";
when 12 =>
return "CUT_BUFFER3";
when 13 =>
return "CUT_BUFFER4";
when 14 =>
return "CUT_BUFFER5";
when 15 =>
return "CUT_BUFFER6";
when 16 =>
return "CUT_BUFFER7";
when 17 =>
return "DRAWABLE";
when 18 =>
return "FONT";
when 19 =>
return "INTEGER";
when 20 =>
return "PIXMAP";
when 21 =>
return "POINT";
when 22 =>
return "RECTANGLE";
when 23 =>
return "RESOURCE_MANAGER";
when 24 =>
return "RGB_COLOR_MAP";
when 25 =>
return "RGB_BEST_MAP";
when 26 =>
return "RGB_BLUE_MAP";
when 27 =>
return "RGB_DEFAULT_MAP";
when 28 =>
return "RGB_GRAY_MAP";
when 29 =>
return "RGB_GREEN_MAP";
when 30 =>
return "RGB_RED_MAP";
when 31 =>
return "STRING";
when 32 =>
return "VISUALID";
when 33 =>
return "WINDOW";
when 34 =>
return "WM_COMMAND";
when 35 =>
return "WM_HINTS";
when 36 =>
return "WM_CLIENT_MACHINE";
when 37 =>
return "WM_ICON_NAME";
when 38 =>
return "WM_ICON_SIZE";
when 39 =>
return "WM_NAME";
when 40 =>
return "WM_NORMAL_HINTS";
when 41 =>
return "WM_SIZE_HINTS";
when 42 =>
return "WM_ZOOM_HINTS";
when 43 =>
return "MIN_SPACE";
when 44 =>
return "NORM_SPACE";
when 45 =>
return "MAX_SPACE";
when 46 =>
return "END_SPACE";
when 47 =>
return "SUPERSCRIPT_X";
when 48 =>
return "SUPERSCRIPT_Y";
when 49 =>
return "SUBSCRIPT_X";
when 50 =>
return "SUBSCRIPT_Y";
when 51 =>
return "UNDERLINE_POSITION";
when 52 =>
return "UNDERLINE_THICKNESS";
when 53 =>
return "STRIKEOUT_ASCENT";
when 54 =>
return "STRIKEOUT_DESCENT";
when 55 =>
return "ITALIC_ANGLE";
when 56 =>
return "X_HEIGHT";
when 57 =>
return "QUAD_WIDTH";
when 58 =>
return "WEIGHT";
when 59 =>
return "POINT_SIZE";
when 60 =>
return "RESOLUTION";
when 61 =>
return "COPYRIGHT";
when 62 =>
return "NOTICE";
when 63 =>
return "FONT_NAME";
when 64 =>
return "FAMILY_NAME";
when 65 =>
return "FULL_NAME";
when 66 =>
return "CAP_HEIGHT";
when 67 =>
return "WM_CLASS";
when 68 =>
return "WM_TRANSIENT_FOR";
when others =>
return "X_Atom'(Number =>" & S_Long'Image (Value.Number) & ")";
end case;
end Image_X_Atom;
procedure Register_X_Atom is
new Debug_Tools.Register (X_Atom, Image_X_Atom);
--\f
function Image_X_Color_Flags (Value : X_Color_Flags;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string of the form "<bit,bit,bit,bit>" where each "bit" is the
-- name of a bit that is turned on.
------------------------------------------------------------------------------
Result : Variable_String (5000);
Last_Crlf : Natural := Prefix'Length;
First : Boolean := True;
begin
Append (Result, '<');
for I in Value'Range loop
if Value (I) then
if First then
First := False;
else
Append (Result, ',');
Last_Crlf := Last_Crlf + 1;
end if;
Add (X_Color_Flags_Index'Image (I), Result, Last_Crlf, Prefix);
end if;
end loop;
Append (Result, '>');
return Image (Result);
end Image_X_Color_Flags;
procedure Register_X_Color_Flags is
new Debug_Tools.Register (X_Color_Flags, Image_X_Color_Flags);
--\f
function Image_X_Key_Sym (Value : X_Key_Sym;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return the decimal and hexadecimal value of a key sym.
------------------------------------------------------------------------------
Result : Variable_String (5000);
Tmp : String (1 .. 16);
begin
Append (Result, '<');
S_Long_Io.Put (Tmp, S_Long (Value), Base => 10);
for I in Tmp'Range loop
if Tmp (I) /= ' ' then
Append (Result, Tmp (I .. Tmp'Last));
exit;
end if;
end loop;
S_Long_Io.Put (Tmp, S_Long (Value), Base => 16);
Append (Result, '/');
for I in Tmp'Range loop
if Tmp (I) /= ' ' then
Append (Result, Tmp (I .. Tmp'Last));
exit;
end if;
end loop;
Append (Result, '>');
return Image (Result);
end Image_X_Key_Sym;
procedure Register_X_Key_Sym is
new Debug_Tools.Register (X_Key_Sym,
Image_X_Key_Sym);
--\f
function Image_X_New_Window_Attributes
(Value : X_New_Window_Attributes;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string of the form "<bit,bit,bit,bit>" where each "bit" is the
-- name of a bit that is turned on.
------------------------------------------------------------------------------
Result : Variable_String (5000);
Last_Crlf : Natural := Prefix'Length;
First : Boolean := True;
begin
Append (Result, '<');
for I in Value'Range loop
if Value (I) then
if First then
First := False;
else
Append (Result, ',');
Last_Crlf := Last_Crlf + 1;
end if;
Add (X_New_Window_Attributes_Index'Image (I),
Result, Last_Crlf, Prefix);
end if;
end loop;
Append (Result, '>');
return Image (Result);
end Image_X_New_Window_Attributes;
procedure Register_X_New_Window_Attributes is
new Debug_Tools.Register (X_New_Window_Attributes,
Image_X_New_Window_Attributes);
--\f
function Image_X_Per_Char_Flags (Value : X_Per_Char_Flags;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string of the form "<bit,bit,bit,bit>" where each "bit" is the
-- name of a bit that is turned on.
------------------------------------------------------------------------------
Result : Variable_String (5000);
Last_Crlf : Natural := Prefix'Length;
First : Boolean := True;
begin
Append (Result, '<');
for I in Value'Range loop
if Value (I) then
if First then
First := False;
else
Append (Result, ',');
Last_Crlf := Last_Crlf + 1;
end if;
Add (X_Per_Char_Flags_Index'Image (I),
Result, Last_Crlf, Prefix);
end if;
end loop;
Append (Result, '>');
return Image (Result);
end Image_X_Per_Char_Flags;
procedure Register_X_Per_Char_Flags is
new Debug_Tools.Register (X_Per_Char_Flags, Image_X_Per_Char_Flags);
--\f
function Image_X_Rm_Quark (Value : X_Rm_Quark;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string containing the name of the quark.
------------------------------------------------------------------------------
Result : Variable_String (5000);
begin
Append (Result, '{');
begin
Append (Result, To_String (X_Rm_Quark_To_String (Value)));
exception
when others =>
Append (Result, "(bad quark value)");
end;
Append (Result, S_Long'Image (Value.Id));
Append (Result, '}');
return Image (Result);
end Image_X_Rm_Quark;
procedure Register_X_Rm_Quark is
new Debug_Tools.Register (X_Rm_Quark, Image_X_Rm_Quark);
--\f
function Image_X_String (Value : X_String;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string containing the contents of an X_String.
------------------------------------------------------------------------------
Result : Variable_String (5000);
begin
Append (Result, '[');
Append (Result, S_Natural'Image (Value'First));
Append (Result, "..");
Append (Result, S_Natural'Image (Value'Last));
Append (Result, "==");
Append (Result, S_Natural'Image (Value'Length));
Append (Result, "] => ");
Append (Result, Ascii.Lf);
Append (Result, Prefix);
Append (Result, '{');
for I in Value'Range loop
if X_Character'Pos (Value (I)) in 0 .. 127 then
if Value (I) = '\' then
Append (Result, '\');
Append (Result, '\');
elsif (Value (I) = Lf) then
Append (Result, Ascii.Lf);
Append (Result, Prefix);
else
Append (Result, Character'Val
(X_Character'Pos (Value (I))));
end if;
else
Append (Result, '\');
Append (Result, Character'Val
(X_Character'Pos (Value (I)) - 128));
end if;
end loop;
Append (Result, '}');
return Image (Result);
end Image_X_String;
procedure Register_X_String is
new Debug_Tools.Register (X_String, Image_X_String);
--\f
function Image_X_Window_Changes_Mask
(Value : X_Window_Changes_Mask;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string of the form "<bit,bit,bit,bit>" where each "bit" is the
-- name of a bit that is turned on.
------------------------------------------------------------------------------
Result : Variable_String (5000);
Last_Crlf : Natural := Prefix'Length;
First : Boolean := True;
begin
Append (Result, '<');
for I in Value'Range loop
if Value (I) then
if First then
First := False;
else
Append (Result, ',');
Last_Crlf := Last_Crlf + 1;
end if;
Add (X_Window_Changes_Mask_Index'Image (I),
Result, Last_Crlf, Prefix);
end if;
end loop;
Append (Result, '>');
return Image (Result);
end Image_X_Window_Changes_Mask;
procedure Register_X_Window_Changes_Mask is
new Debug_Tools.Register (X_Window_Changes_Mask,
Image_X_Window_Changes_Mask);
--\f
function Image_X_Event_Mask (Value : X_Event_Mask;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string of the form "<bit,bit,bit,bit>" where each "bit" is the
-- name of a bit that is turned on.
------------------------------------------------------------------------------
Result : Variable_String (5000);
Last_Crlf : Natural := Prefix'Length;
First : Boolean := True;
begin
Append (Result, '<');
for I in Value'Range loop
if Value (I) then
if First then
First := False;
else
Append (Result, ',');
Last_Crlf := Last_Crlf + 1;
end if;
Add (X_Event_Mask_Index'Image (I), Result, Last_Crlf, Prefix);
end if;
end loop;
Append (Result, '>');
return Image (Result);
end Image_X_Event_Mask;
procedure Register_X_Event_Mask is
new Debug_Tools.Register (X_Event_Mask, Image_X_Event_Mask);
--\f
function Image_X_Enter_Leave_Flags
(Value : X_Enter_Leave_Flags;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string of the form "<bit,bit,bit,bit>" where each "bit" is the
-- name of a bit that is turned on.
------------------------------------------------------------------------------
Result : Variable_String (5000);
Last_Crlf : Natural := Prefix'Length;
First : Boolean := True;
begin
Append (Result, '<');
for I in Value'Range loop
if Value (I) then
if First then
First := False;
else
Append (Result, ',');
Last_Crlf := Last_Crlf + 1;
end if;
Add (X_Enter_Leave_Flags_Index'Image (I),
Result, Last_Crlf, Prefix);
end if;
end loop;
Append (Result, '>');
return Image (Result);
end Image_X_Enter_Leave_Flags;
procedure Register_X_Enter_Leave_Flags is
new Debug_Tools.Register (X_Enter_Leave_Flags,
Image_X_Enter_Leave_Flags);
--\f
function Image_X_Gc_Components (Value : X_Gc_Components;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string of the form "<bit,bit,bit,bit>" where each "bit" is the
-- name of a bit that is turned on.
------------------------------------------------------------------------------
Result : Variable_String (5000);
Last_Crlf : Natural := Prefix'Length;
First : Boolean := True;
begin
Append (Result, '<');
for I in Value'Range loop
if Value (I) then
if First then
First := False;
else
Append (Result, ',');
Last_Crlf := Last_Crlf + 1;
end if;
Add (X_Gc_Components_Index'Image (I),
Result, Last_Crlf, Prefix);
end if;
end loop;
Append (Result, '>');
return Image (Result);
end Image_X_Gc_Components;
procedure Register_X_Gc_Components is
new Debug_Tools.Register (X_Gc_Components, Image_X_Gc_Components);
--\f
function Image_X_Size_Hints_Flags
(Value : X_Size_Hints_Flags;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string of the form "<bit,bit,bit,bit>" where each "bit" is the
-- name of a bit that is turned on.
------------------------------------------------------------------------------
Result : Variable_String (5000);
Last_Crlf : Natural := Prefix'Length;
First : Boolean := True;
begin
Append (Result, '<');
for I in Value'Range loop
if Value (I) then
if First then
First := False;
else
Append (Result, ',');
Last_Crlf := Last_Crlf + 1;
end if;
Add (X_Size_Hints_Flags_Index'Image (I),
Result, Last_Crlf, Prefix);
end if;
end loop;
Append (Result, '>');
return Image (Result);
end Image_X_Size_Hints_Flags;
procedure Register_X_Size_Hints_Flags is
new Debug_Tools.Register (X_Size_Hints_Flags, Image_X_Size_Hints_Flags);
--\f
function Image_X_Wm_Hints_Flags (Value : X_Wm_Hints_Flags;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string of the form "<bit,bit,bit,bit>" where each "bit" is the
-- name of a bit that is turned on.
------------------------------------------------------------------------------
Result : Variable_String (5000);
Last_Crlf : Natural := Prefix'Length;
First : Boolean := True;
begin
Append (Result, '<');
for I in Value'Range loop
if Value (I) then
if First then
First := False;
else
Append (Result, ',');
Last_Crlf := Last_Crlf + 1;
end if;
Add (X_Wm_Hints_Flags_Index'Image (I),
Result, Last_Crlf, Prefix);
end if;
end loop;
Append (Result, '>');
return Image (Result);
end Image_X_Wm_Hints_Flags;
procedure Register_X_Wm_Hints_Flags is
new Debug_Tools.Register (X_Wm_Hints_Flags, Image_X_Wm_Hints_Flags);
--\f
function Image_X_Key_Button_Mask
(Value : X_Key_Button_Mask;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string of the form "<bit,bit,bit,bit>" where each "bit" is the
-- name of a bit that is turned on.
------------------------------------------------------------------------------
Result : Variable_String (5000);
Last_Crlf : Natural := Prefix'Length;
First : Boolean := True;
begin
Append (Result, '<');
for I in Value'Range loop
if Value (I) then
if First then
First := False;
else
Append (Result, ',');
Last_Crlf := Last_Crlf + 1;
end if;
Add (X_Key_Button_Mask_Index'Image (I),
Result, Last_Crlf, Prefix);
end if;
end loop;
Append (Result, '>');
return Image (Result);
end Image_X_Key_Button_Mask;
procedure Register_X_Key_Button_Mask is
new Debug_Tools.Register (X_Key_Button_Mask, Image_X_Key_Button_Mask);
--\f
function Image_X_Keyboard_Control_Flags
(Value : X_Keyboard_Control_Flags;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string of the form "<bit,bit,bit,bit>" where each "bit" is the
-- name of a bit that is turned on.
------------------------------------------------------------------------------
Result : Variable_String (5000);
Last_Crlf : Natural := Prefix'Length;
First : Boolean := True;
begin
Append (Result, '<');
for I in Value'Range loop
if Value (I) then
if First then
First := False;
else
Append (Result, ',');
Last_Crlf := Last_Crlf + 1;
end if;
Add (X_Keyboard_Control_Flags_Index'Image (I),
Result, Last_Crlf, Prefix);
end if;
end loop;
Append (Result, '>');
return Image (Result);
end Image_X_Keyboard_Control_Flags;
procedure Register_X_Keyboard_Control_Flags is
new Debug_Tools.Register (X_Keyboard_Control_Flags,
Image_X_Keyboard_Control_Flags);
--\f
function Image_X_Parse_Geometry_Flags
(Value : X_Parse_Geometry_Flags;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string of the form "<bit,bit,bit,bit>" where each "bit" is the
-- name of a bit that is turned on.
------------------------------------------------------------------------------
Result : Variable_String (5000);
Last_Crlf : Natural := Prefix'Length;
First : Boolean := True;
begin
Append (Result, '<');
for I in Value'Range loop
if Value (I) then
if First then
First := False;
else
Append (Result, ',');
Last_Crlf := Last_Crlf + 1;
end if;
Add (X_Parse_Geometry_Flags_Index'Image (I),
Result, Last_Crlf, Prefix);
end if;
end loop;
Append (Result, '>');
return Image (Result);
end Image_X_Parse_Geometry_Flags;
procedure Register_X_Parse_Geometry_Flags is
new Debug_Tools.Register (X_Parse_Geometry_Flags,
Image_X_Parse_Geometry_Flags);
--\f
function Image_X_Visual_Info_Flags
(Value : X_Visual_Info_Flags;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string of the form "<bit,bit,bit,bit>" where each "bit" is the
-- name of a bit that is turned on.
------------------------------------------------------------------------------
Result : Variable_String (5000);
Last_Crlf : Natural := Prefix'Length;
First : Boolean := True;
begin
Append (Result, '<');
for I in Value'Range loop
if Value (I) then
if First then
First := False;
else
Append (Result, ',');
Last_Crlf := Last_Crlf + 1;
end if;
Add (X_Visual_Info_Flags_Index'Image (I),
Result, Last_Crlf, Prefix);
end if;
end loop;
Append (Result, '>');
return Image (Result);
end Image_X_Visual_Info_Flags;
procedure Register_X_Visual_Info_Flags is
new Debug_Tools.Register (X_Visual_Info_Flags,
Image_X_Visual_Info_Flags);
--\f
function Image_Connection_Id (Value : Transport.Connection_Id;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string of the form "<bit,bit,bit,bit>" where each "bit" is the
-- name of a bit that is turned on.
------------------------------------------------------------------------------
Result : Variable_String (5000);
begin
Append (Result, '<');
if Transport."=" (Value, Transport.Null_Connection_Id) then
Append (Result, "Null_Connection_Id");
else
Append (Result, "non-Null_Connection_Id");
end if;
Append (Result, '>');
return Image (Result);
end Image_Connection_Id;
procedure Register_Connection_Id is
new Debug_Tools.Register (Transport.Connection_Id, Image_Connection_Id);
--\f
function Image_Status_Code (Value : Transport_Defs.Status_Code;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string of the form "<bit,bit,bit,bit>" where each "bit" is the
-- name of a bit that is turned on.
------------------------------------------------------------------------------
Result : Variable_String (5000);
begin
Append (Result, '<');
Append (Result, Transport_Defs.Image (Value));
Append (Result, '>');
return Image (Result);
end Image_Status_Code;
procedure Register_Status_Code is
new Debug_Tools.Register (Transport_Defs.Status_Code, Image_Status_Code);
--\f
function Raw_Data_Image (Value : X_Raw_Data) return String is
------------------------------------------------------------------------------
-- Value - Specifies the value (in the 0..255 range) to convert
--
-- Convert Value into a " ddd(hh)" string. ddd is the decimal value and hh
-- is the hex value.
------------------------------------------------------------------------------
Chr : X_Raw_Data;
Result : String (1 .. 8);
begin
Result (1) := ' ';
if Value > 99 then
Result (2) := Character'Val (Character'Pos ('0') + Value / 100);
else
Result (2) := ' ';
end if;
if Value > 9 then
Result (3) := Character'Val
(Character'Pos ('0') + Value / 10 rem 10);
else
Result (3) := ' ';
end if;
Result (4) := Character'Val (Character'Pos ('0') + Value rem 10);
Result (5) := '(';
Chr := Value / 16;
if Chr > 9 then
Result (6) := Character'Val (Character'Pos ('A') + Chr - 10);
else
Result (6) := Character'Val (Character'Pos ('0') + Chr);
end if;
Chr := Value rem 16;
if Chr > 9 then
Result (7) := Character'Val (Character'Pos ('A') + Chr - 10);
else
Result (7) := Character'Val (Character'Pos ('0') + Chr);
end if;
Result (8) := ')';
return Result;
end Raw_Data_Image;
--\f
function Image_X_Raw_Data_Array (Value : X_Raw_Data_Array;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string of the form "<bit,bit,bit,bit>" where each "bit" is the
-- name of a bit that is turned on.
------------------------------------------------------------------------------
Result : Variable_String (5000);
J : Natural := Value'First;
begin
Append (Result, '[');
Append (Result, Natural'Image (Value'First));
Append (Result, "..");
Append (Result, Natural'Image (Value'Last));
Append (Result, "==");
Append (Result, Natural'Image (Value'Length));
Append (Result, "] => ");
while J < Value'Last loop
Append (Result, Ascii.Lf);
Append (Result, Prefix);
declare
Num : constant String := " " & Natural'Image (J);
begin
Append (Result, Num (Num'Last - 4 .. Num'Last));
end;
Append (Result, ":");
for I in reverse 1 .. 8 loop
Append (Result, Raw_Data_Image (Value (J)));
J := J + 1;
if J > Value'Last then
exit;
end if;
end loop;
end loop;
Append (Result, '>');
return Image (Result);
exception
when others =>
return Image (Result);
end Image_X_Raw_Data_Array;
procedure Register_X_Raw_Data_Array is
new Debug_Tools.Register (X_Raw_Data_Array, Image_X_Raw_Data_Array);
--\f
function Image_X_Buffer (Value : X_Buffer;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string of the form "<bit,bit,bit,bit>" where each "bit" is the
-- name of a bit that is turned on.
------------------------------------------------------------------------------
Result : Variable_String (5000);
J : Natural := 1;
begin
Append (Result, '<');
Append (Result, "Used:");
Append (Result, Natural'Image (Value.Used));
Append (Result, "=>");
while J < Value.Used loop
Append (Result, Ascii.Lf);
Append (Result, Prefix);
declare
Num : constant String := " " & Natural'Image (J);
begin
Append (Result, Num (Num'Last - 4 .. Num'Last));
end;
Append (Result, ":");
for I in reverse 1 .. 8 loop
Append (Result, Raw_Data_Image (Value.Data (J)));
J := J + 1;
if J > Value.Used then
exit;
end if;
end loop;
end loop;
Append (Result, '>');
return Image (Result);
end Image_X_Buffer;
procedure Register_X_Buffer is
new Debug_Tools.Register (X_Buffer, Image_X_Buffer);
--\f
function Image_Subprogram_Type (Value : X_Procedure_Variable;
Level : Natural;
Prefix : String;
Expand_Pointers : Boolean) return String is
------------------------------------------------------------------------------
-- Return a string of the form "<bit,bit,bit,bit>" where each "bit" is the
-- name of a bit that is turned on.
------------------------------------------------------------------------------
Result : Variable_String (5000);
begin
Append (Result, '<');
if Value = None_X_Procedure_Variable then
Append (Result, "None_Proc_Var");
else
Append (Result, "non-None_Proc_Var");
end if;
Append (Result, '>');
return Image (Result);
end Image_Subprogram_Type;
procedure Register_Subprogram_Type is
new Debug_Tools.Register (X_Procedure_Variable, Image_Subprogram_Type);
--/ end if; -- R1000 or Cdf_Hpux
--\f
procedure Register_Debugging_Imagers is
------------------------------------------------------------------------------
-- Registers special debugging printout routines with the R1000 debugger.
------------------------------------------------------------------------------
begin
--/ if R1000 or Cdf_Hpux then
----Subprogram_Implementation
Register_Subprogram_Type;
----Transport
Register_Connection_Id;
Register_Status_Code;
----Basic
Register_X_Atom;
Register_X_Color_Flags;
Register_X_Event_Mask;
Register_X_New_Window_Attributes;
Register_X_Per_Char_Flags;
Register_X_Window_Changes_Mask;
----System
Register_X_Raw_Data_Array;
----Display
Register_X_Buffer;
----Event
Register_X_Enter_Leave_Flags;
----Gc
Register_X_Gc_Components;
----Hints
Register_X_Size_Hints_Flags;
Register_X_Wm_Hints_Flags;
----Key
Register_X_Key_Button_Mask;
Register_X_Key_Sym;
Register_X_Keyboard_Control_Flags;
----RM
Register_X_Rm_Quark;
----String
Register_X_String;
----Utility
Register_X_Parse_Geometry_Flags;
Register_X_Visual_Info_Flags;
--/ else -- not (R1000 or Cdf_Hpux)
--// null;
--/ end if;
end Register_Debugging_Imagers;
--\f
procedure Check_Machine_Assumptions is separate;
--\f
begin
Check_Machine_Assumptions;
end Xlbmp_Debugger;