|
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 - metrics - download
Length: 44032 (0xac00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, generic, package Xlbt_Proc_Var, seg_004f46
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Xlbt_Arithmetic;
use Xlbt_Arithmetic;
with Xlbt_String;
use Xlbt_String;
package Xlbt_Proc_Var is
------------------------------------------------------------------------------
-- X Library Machine Types
--
-- Xlbt_Proc_Var - Machine/Compiler dependent procedure-variable interface
------------------------------------------------------------------------------
-- 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.
------------------------------------------------------------------------------
--\x0c
------------------------------------------------------------------------------
-- X_Procedure_Signature - Unique numeric ID's
------------------------------------------------------------------------------
type X_Procedure_Signature is private;
None_X_Procedure_Signature : constant X_Procedure_Signature;
------------------------------------------------------------------------------
-- X_Procedure_Variable
--
-- Note: On some systems, procedure variable values are implemented by
-- allocating heap storage. Be sure to use the appropriate Free routine
-- on all procedure variable values when they are no longer needed. This
-- will prevent storage loss.
--
-- The GET functions may raise implementation specific exceptions in some
-- cases. E.g. An implementation does not allow a nested procedure to be
-- referenced in this fashion.
--
-- The CALL routine/function will raise X_Invalid_Procedure_Variable if:
-- a) Pv = None_X_Procedure_Variable, or,
-- b) the procedure variable value does not correspond to a value with the
-- proper parameter profile (the signature is different), or,
-- c) Pv is a freed procedure variable value (this may or may not be
-- detectable for all implementations and some other implementation
-- specific exception may be raised instead).
--
-- The FREE routine will raise X_Invalid_Procedure_Variable if:
-- a) Pv = None_X_Procedure_Variable, or,
-- b) the procedure variable value does not correspond to a value with the
-- proper parameter profile (the signature is different), or,
-- c) Pv is a freed procedure variable value (this may or may not be
-- detectable for all implementations and some other implementation
-- specific exception may be raised instead).
------------------------------------------------------------------------------
type X_Procedure_Variable_Rec is private;
type X_Procedure_Variable is access X_Procedure_Variable_Rec;
None_X_Procedure_Variable : constant X_Procedure_Variable := null;
--\x0c
function X_Procedure_Variable_Signature (Pvv : X_Procedure_Variable)
return X_Procedure_Signature;
------------------------------------------------------------------------------
-- Pvv - Specifies the procedure variable to use
--
-- Called to obtain the X_Procedure_Signature value for the specified procedure
-- variable value.
--
-- Raises X_Invalid_Procedure_Variable if
-- a) Ptr = None_X_Procedure_Variable, or,
-- b) Ptr is a freed procedure variable value (this may or may not be
-- detectable for all implementations and some other implementation
-- specific exception may be raised instead).
------------------------------------------------------------------------------
function X_Equal_Signature (Pval1 : X_Procedure_Variable;
Pval2 : X_Procedure_Variable) return Boolean;
function X_Equal_Signature (Pval : X_Procedure_Variable;
Sig : X_Procedure_Signature) return Boolean;
function X_Equal_Signature (Sig1 : X_Procedure_Signature;
Sig2 : X_Procedure_Signature) return Boolean;
--------------------------------------------------------------------------
-- Returns TRUE if a) either value is None or b) the signature value of the
-- first parameter is the same as the signature value for the second parameter.
------------------------------------------------------------------------------
--\x0c
------------------------------------------------------------------------------
-- Procedure Variable - Procedure with 1 In Out parameter.
------------------------------------------------------------------------------
generic
type Parm1 is private;
package Proc_Inout is
type Pv is private;
None : constant Pv;
procedure Call (Pvv : Pv;
Data : in out Parm1);
----Call the procedure variable value with this argument.
generic
with procedure Called (Data : in out Parm1);
function Value return Pv;
----Obtain a procedure variable value for this procedure.
procedure Free (Pvv : in out Pv);
----Called to deallocate the Pv value.
function To_Pv (Pvv : X_Procedure_Variable) return Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable;
private
type Pv is new X_Procedure_Variable;
None : constant Pv := Pv (None_X_Procedure_Variable);
end Proc_Inout;
--\x0c
------------------------------------------------------------------------------
-- Procedure Variable - Procedure with 1 In parameter.
------------------------------------------------------------------------------
generic
type Parm1 is private;
package Proc_In is
type Pv is private;
None : constant Pv;
procedure Call (Pvv : Pv;
Data : in Parm1);
----Call the procedure variable value with this argument.
generic
with procedure Called (Data : in Parm1);
function Value return Pv;
----Obtain a procedure variable value for this procedure.
procedure Free (Pvv : in out Pv);
----Called to deallocate the Pv value.
function To_Pv (Pvv : X_Procedure_Variable) return Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable;
private
type Pv is new X_Procedure_Variable;
None : constant Pv := Pv (None_X_Procedure_Variable);
end Proc_In;
--\x0c
------------------------------------------------------------------------------
-- Procedure Variable - Procedure with 2 In parameters.
------------------------------------------------------------------------------
generic
type Parm1 is private;
type Parm2 is private;
package Proc_In_In is
type Pv is private;
None : constant Pv;
procedure Call (Pvv : Pv;
Data1 : in Parm1;
Data2 : in Parm2);
----Call the procedure variable value with these arguments.
generic
with procedure Called (Data1 : in Parm1;
Data2 : in Parm2);
function Value return Pv;
----Obtain a procedure variable value for this procedure.
procedure Free (Pvv : in out Pv);
----Called to deallocate the Pv value.
function To_Pv (Pvv : X_Procedure_Variable) return Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable;
private
type Pv is new X_Procedure_Variable;
None : constant Pv := Pv (None_X_Procedure_Variable);
end Proc_In_In;
--\x0c
------------------------------------------------------------------------------
-- Procedure Variable - Procedure with 3 In parameters.
------------------------------------------------------------------------------
generic
type Parm1 is private;
type Parm2 is private;
type Parm3 is private;
package Proc_In_In_In is
type Pv is private;
None : constant Pv;
procedure Call (Pvv : Pv;
Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3);
----Call the procedure variable value with these arguments.
generic
with procedure Called (Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3);
function Value return Pv;
----Obtain a procedure variable value for this procedure.
procedure Free (Pvv : in out Pv);
----Called to deallocate the Pv value.
function To_Pv (Pvv : X_Procedure_Variable) return Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable;
private
type Pv is new X_Procedure_Variable;
None : constant Pv := Pv (None_X_Procedure_Variable);
end Proc_In_In_In;
--\x0c
------------------------------------------------------------------------------
-- Procedure Variable - Procedure with 4 In parameters.
------------------------------------------------------------------------------
generic
type Parm1 is private;
type Parm2 is private;
type Parm3 is private;
type Parm4 is private;
package Proc_In_In_In_In is
type Pv is private;
None : constant Pv;
procedure Call (Pvv : Pv;
Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3;
Data4 : in Parm4);
----Call the procedure variable value with these arguments.
generic
with procedure Called (Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3;
Data4 : in Parm4);
function Value return Pv;
----Obtain a procedure variable value for this procedure.
procedure Free (Pvv : in out Pv);
----Called to deallocate the Pv value.
function To_Pv (Pvv : X_Procedure_Variable) return Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable;
private
type Pv is new X_Procedure_Variable;
None : constant Pv := Pv (None_X_Procedure_Variable);
end Proc_In_In_In_In;
--\x0c
------------------------------------------------------------------------------
-- Procedure Variable - Procedure with 10 In parameters.
------------------------------------------------------------------------------
generic
type Parm1 is private;
type Parm2 is private;
type Parm3 is private;
type Parm4 is private;
type Parm5 is private;
type Parm6 is private;
type Parm7 is private;
type Parm8 is private;
type Parm9 is private;
type Parm10 is private;
package Proc_In10 is
type Pv is private;
None : constant Pv;
procedure Call (Pvv : Pv;
Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3;
Data4 : in Parm4;
Data5 : in Parm5;
Data6 : in Parm6;
Data7 : in Parm7;
Data8 : in Parm8;
Data9 : in Parm9;
Data10 : in Parm10);
----Call the procedure variable value with these arguments.
generic
with procedure Called (Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3;
Data4 : in Parm4;
Data5 : in Parm5;
Data6 : in Parm6;
Data7 : in Parm7;
Data8 : in Parm8;
Data9 : in Parm9;
Data10 : in Parm10);
function Value return Pv;
----Obtain a procedure variable value for this procedure.
procedure Free (Pvv : in out Pv);
----Called to deallocate the Pv value.
function To_Pv (Pvv : X_Procedure_Variable) return Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable;
private
type Pv is new X_Procedure_Variable;
None : constant Pv := Pv (None_X_Procedure_Variable);
end Proc_In10;
--\x0c
------------------------------------------------------------------------------
-- Procedure Variable - Procedure with 3 In parameters and 2 out parameters.
------------------------------------------------------------------------------
generic
type Parm1 is private;
type Parm2 is private;
type Parm3 is private;
type Parm4 is private;
type Parm5 is private;
package Proc_In_In_In_Out_Out is
type Pv is private;
None : constant Pv;
procedure Call (Pvv : Pv;
Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3;
Data4 : out Parm4;
Data5 : out Parm5);
----Call the procedure variable value with these arguments.
generic
with procedure Called (Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3;
Data4 : out Parm4;
Data5 : out Parm5);
function Value return Pv;
----Obtain a procedure variable value for this procedure.
procedure Free (Pvv : in out Pv);
----Called to deallocate the Pv value.
function To_Pv (Pvv : X_Procedure_Variable) return Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable;
private
type Pv is new X_Procedure_Variable;
None : constant Pv := Pv (None_X_Procedure_Variable);
end Proc_In_In_In_Out_Out;
--\x0c
------------------------------------------------------------------------------
-- Procedure Variable - Procedure with 2 In parameters and 2 out parameters.
------------------------------------------------------------------------------
generic
type Parm1 is private;
type Parm2 is private;
type Parm3 is private;
type Parm4 is private;
package Proc_In_In_Out_Out is
type Pv is private;
None : constant Pv;
procedure Call (Pvv : Pv;
Data1 : in Parm1;
Data2 : in Parm2;
Data3 : out Parm3;
Data4 : out Parm4);
----Call the procedure variable value with these arguments.
generic
with procedure Called (Data1 : in Parm1;
Data2 : in Parm2;
Data3 : out Parm3;
Data4 : out Parm4);
function Value return Pv;
----Obtain a procedure variable value for this procedure.
procedure Free (Pvv : in out Pv);
----Called to deallocate the Pv value.
function To_Pv (Pvv : X_Procedure_Variable) return Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable;
private
type Pv is new X_Procedure_Variable;
None : constant Pv := Pv (None_X_Procedure_Variable);
end Proc_In_In_Out_Out;
--\x0c
------------------------------------------------------------------------------
-- Function Variable - Function with 1 In parameter.
------------------------------------------------------------------------------
generic
type Parm1 is private;
type Ret is private;
package Func_In is
type Pv is private;
None : constant Pv;
function Call (Pvv : Pv;
Data : in Parm1) return Ret;
----Call the function variable value with this argument.
generic
with function Called (Data : in Parm1) return Ret;
function Value return Pv;
----Obtain a function variable value for this function.
procedure Free (Pvv : in out Pv);
----Called to deallocate the Pv value.
function To_Pv (Pvv : X_Procedure_Variable) return Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable;
private
type Pv is new X_Procedure_Variable;
None : constant Pv := Pv (None_X_Procedure_Variable);
end Func_In;
--\x0c
------------------------------------------------------------------------------
-- Function Variable - Function with 1 In parameters returns X_String.
------------------------------------------------------------------------------
generic
type Parm1 is private;
package Func_In_X_String is
type Pv is private;
None : constant Pv;
function Call (Pvv : Pv;
Data1 : in Parm1) return X_String;
----Call the function variable value with these arguments.
generic
with function Called (Data1 : in Parm1) return X_String;
function Value return Pv;
----Obtain a function variable value for this function.
procedure Free (Pvv : in out Pv);
----Called to deallocate the Pv value.
function To_Pv (Pvv : X_Procedure_Variable) return Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable;
private
type Pv is new X_Procedure_Variable;
None : constant Pv := Pv (None_X_Procedure_Variable);
end Func_In_X_String;
--\x0c
------------------------------------------------------------------------------
-- Function Variable - Function with 3 In parameters returns String.
------------------------------------------------------------------------------
generic
type Parm1 is private;
type Parm2 is private;
type Parm3 is private;
package Func_In_In_In_X_String is
type Pv is private;
None : constant Pv;
function Call (Pvv : Pv;
Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3) return X_String;
----Call the function variable value with these arguments.
generic
with function Called (Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3) return X_String;
function Value return Pv;
----Obtain a function variable value for this function.
procedure Free (Pvv : in out Pv);
----Called to deallocate the Pv value.
function To_Pv (Pvv : X_Procedure_Variable) return Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable;
private
type Pv is new X_Procedure_Variable;
None : constant Pv := Pv (None_X_Procedure_Variable);
end Func_In_In_In_X_String;
--\x0c
------------------------------------------------------------------------------
-- Function Variable - Function with 3 In parameters.
------------------------------------------------------------------------------
generic
type Parm1 is private;
type Parm2 is private;
type Parm3 is private;
type Ret is private;
package Func_In_In_In is
type Pv is private;
None : constant Pv;
function Call (Pvv : Pv;
Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3) return Ret;
----Call the function variable value with this argument.
generic
with function Called (Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3) return Ret;
function Value return Pv;
----Obtain a function variable value for this function.
procedure Free (Pvv : in out Pv);
----Called to deallocate the Pv value.
function To_Pv (Pvv : X_Procedure_Variable) return Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable;
private
type Pv is new X_Procedure_Variable;
None : constant Pv := Pv (None_X_Procedure_Variable);
end Func_In_In_In;
--\x0c
------------------------------------------------------------------------------
-- Function Variable - Function with 5 In parameters.
------------------------------------------------------------------------------
generic
type Parm1 is private;
type Parm2 is private;
type Parm3 is private;
type Parm4 is private;
type Parm5 is private;
type Ret is private;
package Func_In5 is
type Pv is private;
None : constant Pv;
function Call (Pvv : Pv;
Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3;
Data4 : in Parm4;
Data5 : in Parm5) return Ret;
----Call the function variable value with this argument.
generic
with function Called (Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3;
Data4 : in Parm4;
Data5 : in Parm5) return Ret;
function Value return Pv;
----Obtain a function variable value for this function.
procedure Free (Pvv : in out Pv);
----Called to deallocate the Pv value.
function To_Pv (Pvv : X_Procedure_Variable) return Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable;
private
type Pv is new X_Procedure_Variable;
None : constant Pv := Pv (None_X_Procedure_Variable);
end Func_In5;
--\x0c
------------------------------------------------------------------------------
-- Function Variable - Function with 10 In parameters.
------------------------------------------------------------------------------
generic
type Parm1 is private;
type Parm2 is private;
type Parm3 is private;
type Parm4 is private;
type Parm5 is private;
type Parm6 is private;
type Parm7 is private;
type Parm8 is private;
type Parm9 is private;
type Parm10 is private;
type Ret is private;
package Func_In10 is
type Pv is private;
None : constant Pv;
function Call (Pvv : Pv;
Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3;
Data4 : in Parm4;
Data5 : in Parm5;
Data6 : in Parm6;
Data7 : in Parm7;
Data8 : in Parm8;
Data9 : in Parm9;
Data10 : in Parm10) return Ret;
----Call the function variable value with this argument.
generic
with function Called (Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3;
Data4 : in Parm4;
Data5 : in Parm5;
Data6 : in Parm6;
Data7 : in Parm7;
Data8 : in Parm8;
Data9 : in Parm9;
Data10 : in Parm10) return Ret;
function Value return Pv;
----Obtain a function variable value for this function.
procedure Free (Pvv : in out Pv);
----Called to deallocate the Pv value.
function To_Pv (Pvv : X_Procedure_Variable) return Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable;
private
type Pv is new X_Procedure_Variable;
None : constant Pv := Pv (None_X_Procedure_Variable);
end Func_In10;
--\x0c
private
type X_Procedure_Signature is
record
First : S_Long;
Second : S_Long;
end record;
None_X_Procedure_Signature : constant X_Procedure_Signature :=
(First => S_Long'First,
Second => S_Long'First);
type X_Procedure_Data_Rec;
type X_Procedure_Data is access X_Procedure_Data_Rec;
type X_Procedure_Variable_Rec is
record
Key : S_Long;
Data : X_Procedure_Data;
end record;
end Xlbt_Proc_Var;
nblk1=2a
nid=0
hdr6=54
[0x00] rec0=19 rec1=00 rec2=01 rec3=004
[0x01] rec0=14 rec1=00 rec2=02 rec3=01c
[0x02] rec0=12 rec1=00 rec2=03 rec3=054
[0x03] rec0=14 rec1=00 rec2=04 rec3=012
[0x04] rec0=00 rec1=00 rec2=2a rec3=008
[0x05] rec0=11 rec1=00 rec2=05 rec3=046
[0x06] rec0=1c rec1=00 rec2=06 rec3=06a
[0x07] rec0=00 rec1=00 rec2=29 rec3=004
[0x08] rec0=1f rec1=00 rec2=07 rec3=01e
[0x09] rec0=1e rec1=00 rec2=08 rec3=05a
[0x0a] rec0=00 rec1=00 rec2=28 rec3=004
[0x0b] rec0=1e rec1=00 rec2=09 rec3=000
[0x0c] rec0=1a rec1=00 rec2=0a rec3=082
[0x0d] rec0=00 rec1=00 rec2=27 rec3=004
[0x0e] rec0=1c rec1=00 rec2=0b rec3=01c
[0x0f] rec0=1b rec1=00 rec2=0c rec3=032
[0x10] rec0=00 rec1=00 rec2=26 rec3=010
[0x11] rec0=1a rec1=00 rec2=0d rec3=05c
[0x12] rec0=17 rec1=00 rec2=0e rec3=05c
[0x13] rec0=00 rec1=00 rec2=25 rec3=004
[0x14] rec0=1c rec1=00 rec2=0f rec3=028
[0x15] rec0=1e rec1=00 rec2=10 rec3=01a
[0x16] rec0=00 rec1=00 rec2=24 rec3=004
[0x17] rec0=18 rec1=00 rec2=11 rec3=004
[0x18] rec0=00 rec1=00 rec2=23 rec3=004
[0x19] rec0=1d rec1=00 rec2=12 rec3=070
[0x1a] rec0=00 rec1=00 rec2=22 rec3=008
[0x1b] rec0=1e rec1=00 rec2=13 rec3=048
[0x1c] rec0=1d rec1=00 rec2=14 rec3=040
[0x1d] rec0=00 rec1=00 rec2=21 rec3=004
[0x1e] rec0=1a rec1=00 rec2=15 rec3=026
[0x1f] rec0=00 rec1=00 rec2=20 rec3=004
[0x20] rec0=1d rec1=00 rec2=16 rec3=002
[0x21] rec0=00 rec1=00 rec2=1f rec3=008
[0x22] rec0=1d rec1=00 rec2=17 rec3=044
[0x23] rec0=00 rec1=00 rec2=1e rec3=004
[0x24] rec0=19 rec1=00 rec2=18 rec3=03a
[0x25] rec0=00 rec1=00 rec2=1d rec3=004
[0x26] rec0=1d rec1=00 rec2=19 rec3=056
[0x27] rec0=01 rec1=00 rec2=1c rec3=016
[0x28] rec0=15 rec1=00 rec2=1a rec3=038
[0x29] rec0=1e rec1=00 rec2=1b rec3=000
tail 0x2150095c48197819c6b4d 0x42a00088462063203