|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 66560 (0x10400)
Types: Ada Source
Notes: 03_class, FILE, Long Ada Source, R1k_Segment, e3_tag, package body Xlbmp_Debugger, seg_004f00
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦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
--\x0c
------------------------------------------------------------------------------
-- 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;
--\x0c
function Image (Str : Variable_String) return String is begin
return Str.Str (1 .. Str.Length);
end Image;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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);
--\x0c
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);
--\x0c
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);
--\x0c
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);
--\x0c
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);
--\x0c
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);
--\x0c
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);
--\x0c
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);
--\x0c
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);
--\x0c
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);
--\x0c
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);
--\x0c
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);
--\x0c
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);
--\x0c
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);
--\x0c
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);
--\x0c
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);
--\x0c
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);
--\x0c
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);
--\x0c
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);
--\x0c
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;
--\x0c
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);
--\x0c
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);
--\x0c
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
--\x0c
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;
--\x0c
procedure Check_Machine_Assumptions is separate;
--\x0c
begin
Check_Machine_Assumptions;
end Xlbmp_Debugger;
nblk1=40
nid=0
hdr6=80
[0x00] rec0=30 rec1=00 rec2=01 rec3=09c
[0x01] rec0=14 rec1=00 rec2=02 rec3=022
[0x02] rec0=17 rec1=00 rec2=03 rec3=07a
[0x03] rec0=01 rec1=00 rec2=40 rec3=002
[0x04] rec0=1a rec1=00 rec2=04 rec3=056
[0x05] rec0=02 rec1=00 rec2=3f rec3=00a
[0x06] rec0=16 rec1=00 rec2=05 rec3=01c
[0x07] rec0=15 rec1=00 rec2=06 rec3=09c
[0x08] rec0=21 rec1=00 rec2=07 rec3=02c
[0x09] rec0=1e rec1=00 rec2=08 rec3=01e
[0x0a] rec0=1e rec1=00 rec2=09 rec3=00a
[0x0b] rec0=1c rec1=00 rec2=0a rec3=04c
[0x0c] rec0=1f rec1=00 rec2=0b rec3=004
[0x0d] rec0=15 rec1=00 rec2=0c rec3=00c
[0x0e] rec0=00 rec1=00 rec2=3e rec3=00e
[0x0f] rec0=17 rec1=00 rec2=0d rec3=03c
[0x10] rec0=00 rec1=00 rec2=3d rec3=006
[0x11] rec0=1b rec1=00 rec2=0e rec3=02a
[0x12] rec0=19 rec1=00 rec2=0f rec3=034
[0x13] rec0=00 rec1=00 rec2=3c rec3=00e
[0x14] rec0=15 rec1=00 rec2=10 rec3=00e
[0x15] rec0=00 rec1=00 rec2=3b rec3=00e
[0x16] rec0=16 rec1=00 rec2=11 rec3=09c
[0x17] rec0=1b rec1=00 rec2=12 rec3=044
[0x18] rec0=19 rec1=00 rec2=13 rec3=018
[0x19] rec0=19 rec1=00 rec2=14 rec3=028
[0x1a] rec0=1b rec1=00 rec2=15 rec3=018
[0x1b] rec0=00 rec1=00 rec2=3a rec3=00e
[0x1c] rec0=14 rec1=00 rec2=16 rec3=032
[0x1d] rec0=01 rec1=00 rec2=39 rec3=00e
[0x1e] rec0=16 rec1=00 rec2=17 rec3=046
[0x1f] rec0=01 rec1=00 rec2=38 rec3=002
[0x20] rec0=1a rec1=00 rec2=18 rec3=01e
[0x21] rec0=16 rec1=00 rec2=19 rec3=03e
[0x22] rec0=01 rec1=00 rec2=37 rec3=00a
[0x23] rec0=17 rec1=00 rec2=1a rec3=032
[0x24] rec0=00 rec1=00 rec2=36 rec3=00c
[0x25] rec0=17 rec1=00 rec2=1b rec3=054
[0x26] rec0=19 rec1=00 rec2=1c rec3=088
[0x27] rec0=00 rec1=00 rec2=35 rec3=00e
[0x28] rec0=18 rec1=00 rec2=1d rec3=024
[0x29] rec0=00 rec1=00 rec2=34 rec3=00e
[0x2a] rec0=17 rec1=00 rec2=1e rec3=024
[0x2b] rec0=00 rec1=00 rec2=33 rec3=006
[0x2c] rec0=1b rec1=00 rec2=1f rec3=024
[0x2d] rec0=00 rec1=00 rec2=32 rec3=008
[0x2e] rec0=16 rec1=00 rec2=20 rec3=004
[0x2f] rec0=00 rec1=00 rec2=31 rec3=00e
[0x30] rec0=17 rec1=00 rec2=21 rec3=004
[0x31] rec0=00 rec1=00 rec2=30 rec3=00e
[0x32] rec0=1a rec1=00 rec2=22 rec3=02a
[0x33] rec0=16 rec1=00 rec2=23 rec3=05a
[0x34] rec0=15 rec1=00 rec2=24 rec3=05c
[0x35] rec0=1b rec1=00 rec2=25 rec3=01c
[0x36] rec0=00 rec1=00 rec2=2f rec3=014
[0x37] rec0=16 rec1=00 rec2=26 rec3=042
[0x38] rec0=1a rec1=00 rec2=27 rec3=024
[0x39] rec0=00 rec1=00 rec2=2e rec3=00a
[0x3a] rec0=1a rec1=00 rec2=28 rec3=014
[0x3b] rec0=00 rec1=00 rec2=2d rec3=00a
[0x3c] rec0=1e rec1=00 rec2=29 rec3=038
[0x3d] rec0=15 rec1=00 rec2=2a rec3=044
[0x3e] rec0=2d rec1=00 rec2=2b rec3=006
[0x3f] rec0=29 rec1=00 rec2=2c rec3=000
tail 0x21500953c8197801faaed 0x42a00088462063203