|
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: 31744 (0x7c00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package Xlbt_Rm3, seg_004fee
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Text_Io;
with Unchecked_Deallocation;
with Xlbt_Arithmetic;
use Xlbt_Arithmetic;
with Xlbt_Basic;
use Xlbt_Basic;
with Xlbt_Color;
use Xlbt_Color;
with Xlbt_Font;
use Xlbt_Font;
with Xlbt_Hint;
use Xlbt_Hint;
with Xlbt_Proc_Var;
use Xlbt_Proc_Var;
with Xlbt_String7;
use Xlbt_String7;
with Xlbt_String;
use Xlbt_String;
with Xlbt_String16;
use Xlbt_String16;
with Xlbt_Univ_Ptr;
use Xlbt_Univ_Ptr;
with Xlbt_Visual;
use Xlbt_Visual;
with Xlbip_String_Map_Generic;
package Xlbt_Rm3 is
------------------------------------------------------------------------------
-- X Library Resource Manager - Full Interface
--
-- Xlbt_Rm3 - Resource Manager Data Types
------------------------------------------------------------------------------
-- Copyright 1989 - 1991 by Rational, Santa Clara, California.
-- Copyright 1987 - 1989 by Digital Equipment Corporation, Maynard, Mass.
-- Copyright 1987 - 1989 by Massachusetts Institute of Technology,
-- Cambridge, Massachusetts.
--
-- 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 Digital, MIT, or Rational
-- not be used in advertising or publicity pertaining to distribution of
-- the software without specific, written prior permission.
--
-- Digital, MIT, and Rational disclaim all warranties with regard to this
-- software, including all implied warranties of merchantability and fitness,
-- in no event shall Digital, 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.
------------------------------------------------------------------------------
--\x0c
------------------------------------------------------------------------------
-- Misc. X Resource Manager Types
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- X_Rm_Dims
------------------------------------------------------------------------------
type X_Rm_Dims is
record
Width : U_Short := 0;
Height : U_Short := 0;
end record;
------------------------------------------------------------------------------
-- X_Rm_Pos
------------------------------------------------------------------------------
type X_Rm_Pos is
record
X_Pos : S_Short := 0;
Y_Pos : S_Short := 0;
end record;
------------------------------------------------------------------------------
-- X_Rm_Geometry
------------------------------------------------------------------------------
type X_Rm_Geometry is
record
The_Dims : X_Rm_Dims;
The_Pos : X_Rm_Pos;
end record;
------------------------------------------------------------------------------
-- X_Rm_Option_Kind
------------------------------------------------------------------------------
type X_Rm_Option_Kind is
(X_Rm_Option_No_Arg, -- Value is specified in Option_Desc.value
X_Rm_Option_Is_Arg, -- Value is the option string itself
X_Rm_Option_Sticky_Arg, -- Value is characters immediately following option
X_Rm_Option_Sep_Arg, -- Value is next argument in Arg_V
X_Rm_Option_Res_Arg, -- Resource and value in next rg in Arg_V
X_Rm_Option_Skip_Arg, -- Ignore this option and the next argument in Arg_V
X_Rm_Option_Skip_Line, -- Ignore this option and the rest of Arg_V
X_Rm_Option_Skip_N_Args);-- Ignore this option and the next
-- X_Rm_Option_Desc_Rec.value arguments in
-- Arg_V.
None_X_Rm_Option_Kind : constant X_Rm_Option_Kind :=
X_Rm_Option_Kind'Val (0);
------------------------------------------------------------------------------
-- X_Rm_Option_Desc - Command line option mapping to resource entries
------------------------------------------------------------------------------
type X_Rm_Option_Desc is
record
Option : X_String_Pointer;
----Option abbreviation in Arg_V
Specifier : X_String_Pointer;
----Resource name (sans application name)
Arg_Kind : X_Rm_Option_Kind := None_X_Rm_Option_Kind;
----Which style of option it is
Value : X_String_Pointer;
----Default value
end record;
type X_Rm_Option_Desc_Array is
array (S_Natural range <>) of X_Rm_Option_Desc;
--\x0c
------------------------------------------------------------------------------
-- X Resource Manager Quark/String Types
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- X_Rm_Quark
------------------------------------------------------------------------------
type X_Rm_Quark is
record
Id : S_Long := 0;
end record;
--/ if Length_Clauses then
for X_Rm_Quark'Size use 32;
--/ end if;
package X_Rm_Quark_Map is
new Xlbip_String_Map_Generic (Character => X_Character,
Index => S_Natural,
String => X_String,
String_Pointer => X_String_Pointer,
Range_Type => X_Rm_Quark,
Hash_Size => 211,
Exact_Case_Match => True);
type X_Rm_Class is new X_Rm_Quark;
type X_Rm_Name is new X_Rm_Quark;
type X_Rm_Representation is new X_Rm_Quark;
type X_Rm_Quark_Array is array (S_Natural range <>) of X_Rm_Quark;
type X_Rm_Class_Array is array (S_Natural range <>) of X_Rm_Class;
type X_Rm_Name_Array is array (S_Natural range <>) of X_Rm_Name;
type X_Rm_Representation_Array is array (S_Natural range <>) of
X_Rm_Representation;
--/ if Pack then
--// pragma Pack (X_Rm_Quark_Array);
--// pragma Pack (X_Rm_Class_Array);
--// pragma Pack (X_Rm_Name_Array);
--// pragma Pack (X_Rm_Representation_Array);
--/ end if;
type X_Rm_Quark_List is access X_Rm_Quark_Array;
type X_Rm_Class_List is access X_Rm_Class_Array;
type X_Rm_Name_List is access X_Rm_Name_Array;
type X_Rm_Representation_List is access X_Rm_Representation_Array;
--/ if Enable_Deallocation then
pragma Enable_Deallocation (X_Rm_Quark_List);
pragma Enable_Deallocation (X_Rm_Class_List);
pragma Enable_Deallocation (X_Rm_Name_List);
pragma Enable_Deallocation (X_Rm_Representation_List);
--/ end if;
None_X_Rm_Quark : constant X_Rm_Quark := (Id => 0);
None_X_Rm_Class : constant X_Rm_Class := (Id => 0);
None_X_Rm_Name : constant X_Rm_Name := (Id => 0);
None_X_Rm_Representation : constant X_Rm_Representation := (Id => 0);
None_X_Rm_Quark_List : constant X_Rm_Quark_List := null;
None_X_Rm_Class_List : constant X_Rm_Class_List := null;
None_X_Rm_Name_List : constant X_Rm_Name_List := null;
None_X_Rm_Representation_List : constant X_Rm_Representation_List := null;
procedure Free_X_Rm_Quark_List is
new Unchecked_Deallocation (X_Rm_Quark_Array, X_Rm_Quark_List);
procedure Free_X_Rm_Class_List is
new Unchecked_Deallocation (X_Rm_Class_Array,
X_Rm_Class_List);
procedure Free_X_Rm_Name_List is
new Unchecked_Deallocation (X_Rm_Name_Array,
X_Rm_Name_List);
procedure Free_X_Rm_Representation_List is
new Unchecked_Deallocation (X_Rm_Representation_Array,
X_Rm_Representation_List);
------------------------------------------------------------------------------
-- X_Rm_Status - Status of various RM operations; used when X_Status is not
-- sufficient.
------------------------------------------------------------------------------
type X_Rm_Status is
(Rm_Successful, -- Fully successful.
Rm_Had_Errors, -- Had errors, recovery has been attempted.
Rm_Failed); -- Had errors, no further recovery was possible.
--\x0c
------------------------------------------------------------------------------
-- X Resource Manager Database Values
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- X_Rm_Value_Kind - Explicit types of X_Rm_Value's.
------------------------------------------------------------------------------
type X_Rm_Value_Kind is (Is_None, -- Ada types
Is_X_Rm_File_Type,
Is_Boolean,
Is_Float,
-- -- Xlib simples
Is_U_Char_List,
Is_U_Char,
Is_U_Short,
Is_S_Char,
Is_S_Short,
Is_S_Long,
Is_X_String7_Pointer,
Is_X_String_Pointer,
Is_X_String16_Pointer,
Is_X_Universal_Pointer,
-- -- Xlib composites
Is_X_Atom,
Is_X_Color,
Is_X_Colormap,
Is_X_Cursor,
Is_X_Display,
Is_X_Font,
Is_X_Font_Struct,
Is_X_Initial_Window_State,
Is_X_Pixel,
Is_X_Pixmap,
Is_X_Screen,
Is_X_Time,
Is_X_Visual,
Is_X_Window);
------------------------------------------------------------------------------
-- X_Rm_Value_Univ - Data stored when we have a Universal Pointer value.
------------------------------------------------------------------------------
type X_Rm_Universal_Pointer is
record
Pointer : X_Universal_Pointer; -- The data
Free : X_Procedure_Variable; -- X_Univ_Free.Pv
end record;
None_X_Rm_Universal_Pointer : constant X_Rm_Universal_Pointer :=
(None_X_Universal_Pointer, None_X_Procedure_Variable);
------------------------------------------------------------------------------
-- X_Rm_File_Type - Text_Io.File_Type is limited private; ths is not.
------------------------------------------------------------------------------
type X_Rm_File_Type is access Text_Io.File_Type;
procedure Free_X_Rm_File_Type is
new Unchecked_Deallocation (Text_Io.File_Type,
X_Rm_File_Type);
--/ if Enable_Deallocation then
pragma Enable_Deallocation (X_Rm_File_Type);
--/ end if;
None_X_Rm_File_Type : constant X_Rm_File_Type := null;
------------------------------------------------------------------------------
-- X_Rm_Value - Actual Resource Manager Value
------------------------------------------------------------------------------
type X_Rm_Value (Kind : X_Rm_Value_Kind := Is_None) is
record
case Kind is
when Is_None =>
null;
when Is_X_Rm_File_Type =>
V_X_Rm_File_Type : X_Rm_File_Type;
when Is_Boolean =>
V_Boolean : Boolean := False;
when Is_Float =>
V_Float : Float := 0.0;
when Is_U_Char_List =>
V_U_Char_List : U_Char_List := null;
when Is_U_Char =>
V_U_Char : U_Char := 0;
when Is_U_Short =>
V_U_Short : U_Short := 0;
when Is_S_Char =>
V_S_Char : S_Char := 0;
when Is_S_Short =>
V_S_Short : S_Short := 0;
when Is_S_Long =>
V_S_Long : S_Long := 0;
when Is_X_String7_Pointer =>
V_X_String7_Pointer : X_String7_Pointer := null;
when Is_X_String_Pointer =>
V_X_String_Pointer : X_String_Pointer := null;
when Is_X_String16_Pointer =>
V_X_String16_Pointer : X_String16_Pointer := null;
when Is_X_Universal_Pointer =>
V_X_Universal_Pointer : X_Rm_Universal_Pointer;
when Is_X_Atom =>
V_X_Atom : X_Atom := None_X_Atom;
when Is_X_Color =>
V_X_Color : X_Color := None_X_Color;
when Is_X_Colormap =>
V_X_Colormap : X_Colormap := None_X_Colormap;
when Is_X_Cursor =>
V_X_Cursor : X_Cursor := None_X_Cursor;
when Is_X_Display =>
V_X_Display : X_Display := None_X_Display;
when Is_X_Font =>
V_X_Font : X_Font := None_X_Font;
when Is_X_Font_Struct =>
V_X_Font_Struct : X_Font_Struct := None_X_Font_Struct;
when Is_X_Initial_Window_State =>
V_X_Initial_Window_State : X_Initial_Window_State :=
None_X_Initial_Window_State;
when Is_X_Pixel =>
V_X_Pixel : X_Pixel := None_X_Pixel;
when Is_X_Pixmap =>
V_X_Pixmap : X_Pixmap := None_X_Pixmap;
when Is_X_Screen =>
V_X_Screen : X_Screen := None_X_Screen;
when Is_X_Time =>
V_X_Time : X_Time := None_X_Time;
when Is_X_Visual =>
V_X_Visual : X_Visual := None_X_Visual;
when Is_X_Window =>
V_X_Window : X_Window := None_X_Window;
end case;
end record;
None_X_Rm_Value : constant X_Rm_Value := (Kind => Is_None);
--\x0c
------------------------------------------------------------------------------
-- X_Rm_Entry - Resource Database Entry
------------------------------------------------------------------------------
type X_Rm_Entry_Rec;
type X_Rm_Entry is access X_Rm_Entry_Rec;
--/ if Enable_Deallocation then
pragma Enable_Deallocation (X_Rm_Entry);
--/ end if;
None_X_Rm_Entry : constant X_Rm_Entry := null;
type X_Rm_Entry_Rec is
record
Owner : Boolean := False;
----True when deallocation of this Entry means that the Value
-- should also be deallocated. I.e. True means that the
-- enclosing database "owns" this data and is responsible for
-- deallocating it when the database releases its last reference.
Representation : X_Rm_Representation := None_X_Rm_Representation;
----The "actual" representation type of the data. The merely
-- "physical" representation is the .Value.Kind enumeration
-- value but this field indicates the representation type
-- that the user wishes to think with.
Value : X_Rm_Value;
----This field contains the data that makes up the X_Rm_Entry.
end record;
--\x0c
------------------------------------------------------------------------------
-- X Resource Manager Databases
------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- X_Rm_Binding
------------------------------------------------------------------------------
type X_Rm_Binding is
(X_Rm_Bind_Tightly,
X_Rm_Bind_Loosely);
type X_Rm_Binding_Array is array (S_Natural range <>) of X_Rm_Binding;
------------------------------------------------------------------------------
-- X_Rm_Hash_Bucket - records a value and possibly dependent/refined values.
------------------------------------------------------------------------------
type X_Rm_Hash_Bucket_Rec;
type X_Rm_Hash_Bucket is access X_Rm_Hash_Bucket_Rec;
type X_Rm_Hash_Bucket_Array is array (S_Natural range 0 .. 58) of
X_Rm_Hash_Bucket; -- 59 is a prime.
type X_Rm_Hash_Table is access X_Rm_Hash_Bucket_Array;
type X_Rm_Hash_Table_Set is array (X_Rm_Binding) of X_Rm_Hash_Table;
type X_Rm_Hash_Table_Flags is array (X_Rm_Binding) of Boolean;
--/ if Enable_Deallocation then
pragma Enable_Deallocation (X_Rm_Hash_Bucket);
pragma Enable_Deallocation (X_Rm_Hash_Table);
--/ end if;
------------------------------------------------------------------------------
-- X_Rm_Hash_Bucket_Rec
--
-- Next - Next bucket in this hash chain
-- Name - Quark value corresponding to this name string
-- Value - Value and type of node; if any
-- Tables - Tables for tight/loose bindings of more qualified values
-- Has_Values - True if the corresponding Tables(i) table has a value
------------------------------------------------------------------------------
type X_Rm_Hash_Bucket_Rec is
record
Next : X_Rm_Hash_Bucket := null;
Name : X_Rm_Name := None_X_Rm_Name;
Value : X_Rm_Entry := null;
Tables : X_Rm_Hash_Table_Set := (null, null);
Has_Values : X_Rm_Hash_Table_Flags := (False, False);
end record;
None_X_Rm_Hash_Bucket : constant X_Rm_Hash_Bucket := null;
None_X_Rm_Hash_Table : constant X_Rm_Hash_Table := null;
None_X_Rm_Hash_Bucket_Rec : constant X_Rm_Hash_Bucket_Rec :=
(null, None_X_Rm_Name, null, (null, null), (False, False));
procedure Free_X_Rm_Hash_Bucket is
new Unchecked_Deallocation (X_Rm_Hash_Bucket_Rec,
X_Rm_Hash_Bucket);
procedure Free_X_Rm_Hash_Table is
new Unchecked_Deallocation (X_Rm_Hash_Bucket_Array,
X_Rm_Hash_Table);
------------------------------------------------------------------------------
-- X_Rm_Quark_Bit_List - array of bits used to speed RM processing
------------------------------------------------------------------------------
type X_Rm_Quark_Bit_Array is array (S_Natural range <>) of Boolean;
type X_Rm_Quark_Bit_List is access X_Rm_Quark_Bit_Array;
--/ if Pack then
--// pragma Pack (X_Rm_Quark_Bit_Array);
--/ end if;
--/ if Enable_Deallocation then
pragma Enable_Deallocation (X_Rm_Quark_Bit_List);
--/ end if;
None_X_Rm_Quark_Bit_List : constant X_Rm_Quark_Bit_List := null;
procedure Free_X_Rm_Quark_Bit_List is
new Unchecked_Deallocation (X_Rm_Quark_Bit_Array,
X_Rm_Quark_Bit_List);
------------------------------------------------------------------------------
-- X_Rm_Database - A record (possibly) containing a Hash Bucket pointer.
------------------------------------------------------------------------------
type X_Rm_Database_Rec is
record
Contents : X_Rm_Hash_Bucket;
end record;
type X_Rm_Database is access X_Rm_Database_Rec;
--/ if Enable_Deallocation then
pragma Enable_Deallocation (X_Rm_Database);
--/ end if;
None_X_Rm_Database : constant X_Rm_Database := null;
------------------------------------------------------------------------------
-- X_Rm_Search_List - a series of related Hash Tables
------------------------------------------------------------------------------
type X_Rm_Search_List_Entry is new X_Rm_Hash_Table;
type X_Rm_Search_List is
array (S_Natural range <>) of X_Rm_Search_List_Entry;
--\x0c
end Xlbt_Rm3;
nblk1=1e
nid=0
hdr6=3c
[0x00] rec0=26 rec1=00 rec2=01 rec3=026
[0x01] rec0=11 rec1=00 rec2=02 rec3=03a
[0x02] rec0=1a rec1=00 rec2=03 rec3=00c
[0x03] rec0=00 rec1=00 rec2=1e rec3=002
[0x04] rec0=17 rec1=00 rec2=04 rec3=07e
[0x05] rec0=00 rec1=00 rec2=1d rec3=002
[0x06] rec0=14 rec1=00 rec2=05 rec3=07c
[0x07] rec0=1e rec1=00 rec2=06 rec3=00a
[0x08] rec0=13 rec1=00 rec2=07 rec3=018
[0x09] rec0=01 rec1=00 rec2=1c rec3=022
[0x0a] rec0=14 rec1=00 rec2=08 rec3=052
[0x0b] rec0=01 rec1=00 rec2=1b rec3=08c
[0x0c] rec0=14 rec1=00 rec2=09 rec3=02a
[0x0d] rec0=01 rec1=00 rec2=1a rec3=02a
[0x0e] rec0=15 rec1=00 rec2=0a rec3=018
[0x0f] rec0=15 rec1=00 rec2=0b rec3=032
[0x10] rec0=17 rec1=00 rec2=0c rec3=030
[0x11] rec0=00 rec1=00 rec2=17 rec3=006
[0x12] rec0=1b rec1=00 rec2=0d rec3=00a
[0x13] rec0=14 rec1=00 rec2=0e rec3=046
[0x14] rec0=13 rec1=00 rec2=0f rec3=038
[0x15] rec0=1b rec1=00 rec2=10 rec3=024
[0x16] rec0=15 rec1=00 rec2=11 rec3=09a
[0x17] rec0=16 rec1=00 rec2=12 rec3=04c
[0x18] rec0=17 rec1=00 rec2=19 rec3=058
[0x19] rec0=00 rec1=00 rec2=14 rec3=022
[0x1a] rec0=15 rec1=00 rec2=13 rec3=024
[0x1b] rec0=02 rec1=00 rec2=18 rec3=002
[0x1c] rec0=1c rec1=00 rec2=15 rec3=032
[0x1d] rec0=10 rec1=00 rec2=16 rec3=000
tail 0x2150097108197851d3413 0x42a00088462063203