|
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: 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