|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 175230 (0x2ac7e)
Types: TextFile
Names: »B«
└─⟦85b835f43⟧ Bits:30000549 8mm tape, Rational 1000, Xlib rev 6.00
└─ ⟦0c20f784e⟧ »DATA«
└─⟦1abbe589f⟧
└─⟦059497ac5⟧
└─⟦this⟧
--/ if R1000 then
with Subprogram_Implementation;
--/ elsif Cdf_Hpux then
--// with System;
--/ elsif TeleGen2 and then Unix then
--// with System;
--/ end if;
with Unchecked_Deallocation;
with Xlbt_Arithmetic;
use Xlbt_Arithmetic;
with Xlbt_Exceptions;
use Xlbt_Exceptions;
with Xlbt_String;
use Xlbt_String;
with Xlbit_Library2;
use Xlbit_Library2;
with Xlbmt_Network_Types;
use Xlbmt_Network_Types;
package body 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.
------------------------------------------------------------------------------
--\f
------------------------------------------------------------------------------
-- X_Procedure_Variable - type completions
--
-- A procedure variable is a pointer to a record. Key is used to validate the
-- Data pointer. Pvv.Data.Key /= Pvv.Key means that the procedure variable
-- has gone "stale" (it has been freed). As a secondary check we also check
-- Pvv.Data.Sig for being the correct signature. Since our implementation is
-- "type safe" we know that the Sig should be correct; however, since the
-- problem of dangling pointers to freed data cannot be solved in Ada (without
-- garbage collection and the removal of Unchecked_Deallocation) we may still
-- have a "stale" pointer that needs to be caught. We can't guarantee it.
------------------------------------------------------------------------------
----Each procedure variable has a pointer to the data we need to invoke a
-- procedure.
-- Key - This is a signature value that is used to determine when
-- a procedure variable value has gone "stale". A stale value
-- is one that has been freed. We can't guarantee to catch
-- 100% of all such things but we can catch "many" of them.
-- Sig - This is the "signature" value for the procedure. We use this
-- to determine whether or not the procedure variable value
-- is of the correct "type" (correct parameter list). If a
-- value has been freed then this may or may not also help us
-- catch use of a dangling pointer, but it helps.
Magic_Value : constant S_Long := 16#71F2D3C4#; -- semi-random value
type X_Procedure_Data_Rec is
record
Key : S_Long;
Sig : X_Procedure_Signature;
--/ if R1000 then
Subprog : Subprogram_Implementation.Subprogram_Type;
--/ elsif Cdf_Hpux then
--// Subprog : System.Address;
--// A1 : System.Address;
--/ elsif TeleGen2 and then Unix then
--// Subprog : System.Address;
--// A4 : System.Address;
--/ else
--// What_Is : Something;
--/ end if;
end record;
procedure Heap_Free_X_Procedure_Data is
new Unchecked_Deallocation (X_Procedure_Data_Rec,
X_Procedure_Data);
procedure Heap_Free_X_Procedure_Variable is
new Unchecked_Deallocation (X_Procedure_Variable_Rec,
X_Procedure_Variable);
--\f
------------------------------------------------------------------------------
-- X_Procedure_Signature
--
-- Multitasking! We need a Mutex to guard our Signature_Source. We use the
-- one attached to X_Lib.
------------------------------------------------------------------------------
Signature_Source : X_Procedure_Signature := None_X_Procedure_Signature;
--\f
------------------------------------------------------------------------------
-- R1000 Subprogram Variables
------------------------------------------------------------------------------
--/ if R1000 then
package Si renames Subprogram_Implementation;
Modes_Proc_Inout : constant Si.Mode_Vector := (1 => Si.In_Out_Mode);
Modes_Proc_In : constant Si.Mode_Vector := (1 => Si.In_Mode);
Modes_Proc_In_In : constant Si.Mode_Vector := (1 .. 2 => Si.In_Mode);
Modes_Proc_In_In_In : constant Si.Mode_Vector := (1 .. 3 => Si.In_Mode);
Modes_Proc_In_In_In_In : constant Si.Mode_Vector := (1 .. 4 => Si.In_Mode);
Modes_Proc_In10 : constant Si.Mode_Vector := (1 .. 10 => Si.In_Mode);
Modes_Proc_In_In_In_Out_Out :
constant
Si.Mode_Vector := (1 .. 3 => Si.In_Mode,
4 .. 5 => Si.Out_Mode);
Modes_Proc_Out_In : constant Si.Mode_Vector := (1 => Si.Out_Mode,
2 => Si.In_Mode);
Modes_Proc_In_In_Out_Out : constant Si.Mode_Vector :=
(1 .. 2 => Si.In_Mode,
3 .. 4 => Si.Out_Mode);
Modes_Func_In : constant Si.Mode_Vector := (1 => Si.In_Mode,
2 => Si.Return_Mode);
Modes_Func_In_In_In : constant Si.Mode_Vector := (1 .. 3 => Si.In_Mode,
4 => Si.Return_Mode);
-- function Uca_Placeholder is new Si.Return_Placeholder (U_Char_Array);
Modes_Func_In_X_String : constant Si.Mode_Vector := (1 => Si.In_Mode,
2 => Si.Return_Mode);
function String_Placeholder is new Si.Return_Placeholder (X_String);
Modes_Func_In_In_In_X_String :
constant
Si.Mode_Vector := (1 .. 3 => Si.In_Mode,
4 => Si.Return_Mode);
Modes_Func_In5 : constant Si.Mode_Vector := (1 .. 5 => Si.In_Mode,
6 => Si.Return_Mode);
Modes_Func_In10 : constant Si.Mode_Vector := (1 .. 10 => Si.In_Mode,
11 => Si.Return_Mode);
--/ end if; -- R1000
--\f
procedure Free_X_Procedure_Variable (Var : in out X_Procedure_Variable) is
------------------------------------------------------------------------------
-- Var - Specifies what to free. Our caller has verified that this
-- value is not "stale" before calling.
--
-- Called to uninitialize and then to free a procedure variable value. This
-- is done so that we have a chance of detecting "stale" or dangling values.
------------------------------------------------------------------------------
begin
Var.Data.Sig := None_X_Procedure_Signature;
Var.Data.Key := 0;
Var.Key := 0;
Heap_Free_X_Procedure_Data (Var.Data);
Heap_Free_X_Procedure_Variable (Var);
end Free_X_Procedure_Variable;
--\f
--/ if Cdf_Hpux then
--//
--// function New_Procedure_Data
--// (Sig : X_Procedure_Signature;
--// Subprog : System.Address;
--// A1 : System.Address) return X_Procedure_Variable is
--// ------------------------------------------------------------------------------
--// -- Allocate storage for a new procedure variable.
--// ------------------------------------------------------------------------------
--// begin
--//
--// return new X_Procedure_Variable_Rec'
--// (Key => Magic_Value,
--// Data => new X_Procedure_Data_Rec'(Key => Magic_Value,
--// Sig => Sig,
--// Subprog => Subprog,
--// A1 => A1));
--//
--// end New_Procedure_Data;
--/ end if;
--\f
--/ if TeleGen2 and then Unix then
--//
--// function New_Procedure_Data
--// (Sig : X_Procedure_Signature;
--// Subprog : System.Address;
--// A4 : System.Address) return X_Procedure_Variable is
--// ------------------------------------------------------------------------------
--// -- Allocate storage for a new procedure variable. We do this outside of the
--// -- generics for the TeleSoft compiler in order to get around a compiler bug
--// -- that causes the compiler to go belly-up.
--// ------------------------------------------------------------------------------
--// begin
--//
--// return new X_Procedure_Variable_Rec'
--// (Key => Magic_Value,
--// Data => new X_Procedure_Data_Rec'(Key => Magic_Value,
--// Sig => Sig,
--// Subprog => Subprog,
--// A4 => A4));
--//
--// end New_Procedure_Data;
--//
--/ end if;
--\f
function X_Unique_Procedure_Signature return X_Procedure_Signature is
------------------------------------------------------------------------------
-- Compute and return the next available signature value.
------------------------------------------------------------------------------
Sig : X_Procedure_Signature;
begin
Lock_Mutex (Mutex);
begin
if Signature_Source.Second = S_Long'Last then
Signature_Source.Second := S_Long'First;
Signature_Source.First := Signature_Source.First + 1;
else
Signature_Source.Second := Signature_Source.Second + 1;
end if;
Sig := Signature_Source;
exception
when others =>
Unlock_Mutex (Mutex);
raise;
end;
Unlock_Mutex (Mutex);
return Sig;
end X_Unique_Procedure_Signature;
--\f
function X_Equal_Signature (Pval1 : X_Procedure_Variable;
Pval2 : X_Procedure_Variable) return Boolean is
--------------------------------------------------------------------------
-- 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.
------------------------------------------------------------------------------
begin
if Pval1 = None_X_Procedure_Variable or else
Pval2 = None_X_Procedure_Variable then
return True;
end if;
if Pval1.Key /= Magic_Value or else
Pval1.Data.Key /= Magic_Value then
raise X_Bad_Procedure_Variable;
elsif Pval2.Key /= Magic_Value or else
Pval2.Data.Key /= Magic_Value then
raise X_Bad_Procedure_Variable;
end if;
return Pval1.Data.Sig = Pval2.Data.Sig;
end X_Equal_Signature;
--\f
function X_Equal_Signature (Pval : X_Procedure_Variable;
Sig : X_Procedure_Signature) return Boolean is
--------------------------------------------------------------------------
-- 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.
------------------------------------------------------------------------------
begin
if Pval = None_X_Procedure_Variable then
return True;
end if;
if Pval.Key /= Magic_Value or else
Pval.Data.Key /= Magic_Value then
raise X_Bad_Procedure_Variable;
end if;
return Pval.Data.Sig = Sig;
end X_Equal_Signature;
--\f
function X_Equal_Signature (Sig1 : X_Procedure_Signature;
Sig2 : X_Procedure_Signature) return Boolean is
--------------------------------------------------------------------------
-- 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.
------------------------------------------------------------------------------
begin
return Sig1 = Sig2;
end X_Equal_Signature;
--\f
------------------------------------------------------------------------------
-- Procedure with 1 In Out parameter.
------------------------------------------------------------------------------
--/ if R1000 then
package body Proc_Inout is
Signature : constant X_Procedure_Signature :=
X_Unique_Procedure_Signature;
Signature1 : constant Long_Integer :=
Long_Integer (Signature.First) * 2 ** 31 +
Long_Integer (Signature.Second);
procedure Call (Pvv : Pv;
Data : in out Parm1) is
Pvvv : Subprogram_Implementation.Subprogram_Type;
Offset : constant Si.Offset_Vector := (Pvvv'Offset, Data'Offset);
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Pvvv := Pvv.Data.Subprog;
Si.Invoke (Modes_Proc_Inout, Offset);
end Call;
function Value return Pv is
Pdr : X_Procedure_Data;
Pvr : X_Procedure_Variable;
begin
Pdr := new X_Procedure_Data_Rec'
(Key => Magic_Value,
Sig => Signature,
Subprog => Si.Get (Modes_Proc_Inout, Signature1));
Pvr := new X_Procedure_Variable_Rec'
(Key => Magic_Value,
Data => Pdr);
return Pv (Pvr);
exception
when others =>
Heap_Free_X_Procedure_Data (Pdr);
Heap_Free_X_Procedure_Variable (Pvr);
raise;
end Value;
procedure Free (Pvv : in out Pv) is
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
end Free;
function To_Pv (Pvv : X_Procedure_Variable) return Pv is
begin
if Pvv = None_X_Procedure_Variable then
return None;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return Pv (Pvv);
end To_Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable is
begin
if Pvv = None then
return None_X_Procedure_Variable;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return X_Procedure_Variable (Pvv);
end From_Pv;
end Proc_Inout;
--/ end if; -- R1000
--\f
------------------------------------------------------------------------------
-- Procedure with 1 In Out parameter.
------------------------------------------------------------------------------
--/ if Cdf_Hpux then
--//
--// package body Proc_Inout is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// procedure Invoke_Subprog (Subprog : System.Address;
--// A1 : System.Address;
--// Offset : Integer);
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Import_Procedure (Internal => Invoke_Subprog,
--// External => "__Xlbmt_InOut_Invoke_Procedure",
--// Parameter_Types => (System.Address,
--// System.Address, Integer),
--// Mechanism => (Value, Value, Value));
--//
--// function Get_A7 return Integer;
--// pragma Interface (Assembly, Get_A7);
--// pragma Import_Function (Internal => Get_A7,
--// External => "__Xlbmt_Get_A7",
--// Parameter_Types => null,
--// Result_Type => Integer);
--//
--// function Get_A1 return System.Address;
--// pragma Interface (Assembly, Get_A1);
--// pragma Import_Function (Internal => Get_A1,
--// External => "__Xlbmt_Get_A1",
--// Parameter_Types => null,
--// Result_Type => System.Address);
--//
--// procedure Call (Pvv : Pv; Data : in out Parm1) is
--// Sp1, Sp2 : Integer;
--//
--// procedure Call (Data : in out Parm1) is
--// begin
--// Sp2 := Get_A7;
--// end Call;
--//
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--//
--// Sp1 := Get_A7;
--// Call (Data);
--// Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A1, Sp1 - Sp2);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A1);
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Proc_Inout;
--//
--/ end if; -- Cdf_Hpux
--\f
------------------------------------------------------------------------------
-- Procedure with 1 In Out parameter.
------------------------------------------------------------------------------
--/ if TeleGen2 and then Unix then
--//
--// package body Proc_Inout is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// procedure Invoke_Subprog (Subprog : System.Address;
--// A4 : System.Address;
--// Arg1 : System.Address);
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Linkname (Invoke_Subprog, "_Xlbmt_InOut_Invoke_Procedure");
--//
--// function Get_A4 return System.Address;
--// pragma Interface (Assembly, Get_A4);
--// pragma Linkname (Get_A4, "_Xlbmt_Get_A4");
--//
--// procedure Call (Pvv : Pv;
--// Data : in out Parm1) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A4, Pvv'Address);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A4 );
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Proc_Inout;
--//
--/ end if; -- TeleGen2 and then Unix
--\f
------------------------------------------------------------------------------
-- Procedure with 1 In parameter.
------------------------------------------------------------------------------
--/ if R1000 then
package body Proc_In is
Signature : constant X_Procedure_Signature :=
X_Unique_Procedure_Signature;
Signature1 : constant Long_Integer :=
Long_Integer (Signature.First) * 2 ** 31 +
Long_Integer (Signature.Second);
procedure Call (Pvv : Pv;
Data : in Parm1) is
Pvvv : Subprogram_Implementation.Subprogram_Type;
Offset : constant Si.Offset_Vector := (Pvvv'Offset, Data'Offset);
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Pvvv := Pvv.Data.Subprog;
Si.Invoke (Modes_Proc_In, Offset);
end Call;
function Value return Pv is
Pdr : X_Procedure_Data;
Pvr : X_Procedure_Variable;
begin
Pdr := new X_Procedure_Data_Rec'
(Key => Magic_Value,
Sig => Signature,
Subprog => Si.Get (Modes_Proc_In, Signature1));
Pvr := new X_Procedure_Variable_Rec'
(Key => Magic_Value,
Data => Pdr);
return Pv (Pvr);
exception
when others =>
Heap_Free_X_Procedure_Data (Pdr);
Heap_Free_X_Procedure_Variable (Pvr);
raise;
end Value;
procedure Free (Pvv : in out Pv) is
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
end Free;
function To_Pv (Pvv : X_Procedure_Variable) return Pv is
begin
if Pvv = None_X_Procedure_Variable then
return None;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return Pv (Pvv);
end To_Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable is
begin
if Pvv = None then
return None_X_Procedure_Variable;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return X_Procedure_Variable (Pvv);
end From_Pv;
end Proc_In;
--/ end if; -- R1000
--\f
------------------------------------------------------------------------------
-- Procedure with 1 In parameter.
------------------------------------------------------------------------------
--/ if Cdf_Hpux then
--//
--// package body Proc_In is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// procedure Invoke_Subprog (Subprog : System.Address;
--// A1 : System.Address;
--// Offset : Integer);
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Import_Procedure (Internal => Invoke_Subprog,
--// External => "__Xlbmt_In_Invoke_Procedure",
--// Parameter_Types => (System.Address,
--// System.Address, Integer),
--// Mechanism => (Value, Value, Value));
--//
--// function Get_A7 return Integer;
--// pragma Interface (Assembly, Get_A7);
--// pragma Import_Function (Internal => Get_A7,
--// External => "__Xlbmt_Get_A7",
--// Parameter_Types => null,
--// Result_Type => Integer);
--//
--// function Get_A1 return System.Address;
--// pragma Interface (Assembly, Get_A1);
--// pragma Import_Function (Internal => Get_A1,
--// External => "__Xlbmt_Get_A1",
--// Parameter_Types => null,
--// Result_Type => System.Address);
--//
--// procedure Call (Pvv : Pv; Data : in Parm1) is
--// Sp1, Sp2 : Integer;
--//
--// procedure Call (Data : in Parm1) is
--// begin
--// Sp2 := Get_A7;
--// end Call;
--//
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--//
--// Sp1 := Get_A7;
--// Call (Data);
--// Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A1, Sp1 - Sp2);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A1);
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Proc_In;
--//
--/ end if; -- Cdf_Hpux
--\f
------------------------------------------------------------------------------
-- Procedure with 1 In parameter.
------------------------------------------------------------------------------
--/ if TeleGen2 and then Unix then
--//
--// package body Proc_In is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// procedure Invoke_Subprog (Subprog : System.Address;
--// A4 : System.Address;
--// Arg1 : System.Address);
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Linkname (Invoke_Subprog, "_Xlbmt_In_Invoke_Procedure");
--//
--// function Get_A4 return System.Address;
--// pragma Interface (Assembly, Get_A4);
--// pragma Linkname (Get_A4, "_Xlbmt_Get_A4");
--//
--// procedure Call (Pvv : Pv;
--// Data : in Parm1) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A4, Pvv'Address);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A4 );
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Proc_In;
--//
--/ end if; -- TeleGen2 and then Unix
--\f
------------------------------------------------------------------------------
-- Procedure with 2 In parameters.
------------------------------------------------------------------------------
--/ if R1000 then
package body Proc_In_In is
Signature : constant X_Procedure_Signature :=
X_Unique_Procedure_Signature;
Signature1 : constant Long_Integer :=
Long_Integer (Signature.First) * 2 ** 31 +
Long_Integer (Signature.Second);
procedure Call (Pvv : Pv;
Data1 : in Parm1;
Data2 : in Parm2) is
Pvvv : Subprogram_Implementation.Subprogram_Type;
Offset : constant Si.Offset_Vector :=
(Pvvv'Offset, Data1'Offset, Data2'Offset);
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Pvvv := Pvv.Data.Subprog;
Si.Invoke (Modes_Proc_In_In, Offset);
end Call;
function Value return Pv is
Pdr : X_Procedure_Data;
Pvr : X_Procedure_Variable;
begin
Pdr := new X_Procedure_Data_Rec'
(Key => Magic_Value,
Sig => Signature,
Subprog => Si.Get (Modes_Proc_In_In, Signature1));
Pvr := new X_Procedure_Variable_Rec'
(Key => Magic_Value,
Data => Pdr);
return Pv (Pvr);
exception
when others =>
Heap_Free_X_Procedure_Data (Pdr);
Heap_Free_X_Procedure_Variable (Pvr);
raise;
end Value;
procedure Free (Pvv : in out Pv) is
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
end Free;
function To_Pv (Pvv : X_Procedure_Variable) return Pv is
begin
if Pvv = None_X_Procedure_Variable then
return None;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return Pv (Pvv);
end To_Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable is
begin
if Pvv = None then
return None_X_Procedure_Variable;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return X_Procedure_Variable (Pvv);
end From_Pv;
end Proc_In_In;
--/ end if; -- R1000
--\f
------------------------------------------------------------------------------
-- Procedure with 2 In parameters.
------------------------------------------------------------------------------
--/ if Cdf_Hpux then
--//
--// package body Proc_In_In is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// procedure Invoke_Subprog (Subprog : System.Address;
--// A1 : System.Address;
--// Offset : Integer);
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Import_Procedure (Internal => Invoke_Subprog,
--// External => "__Xlbmt_In_Invoke_Procedure",
--// Parameter_Types => (System.Address,
--// System.Address, Integer),
--// Mechanism => (Value, Value, Value));
--//
--// function Get_A7 return Integer;
--// pragma Interface (Assembly, Get_A7);
--// pragma Import_Function (Internal => Get_A7,
--// External => "__Xlbmt_Get_A7",
--// Parameter_Types => null,
--// Result_Type => Integer);
--//
--// function Get_A1 return System.Address;
--// pragma Interface (Assembly, Get_A1);
--// pragma Import_Function (Internal => Get_A1,
--// External => "__Xlbmt_Get_A1",
--// Parameter_Types => null,
--// Result_Type => System.Address);
--//
--// procedure Call (Pvv : Pv; Data1 : in Parm1; Data2 : in Parm2) is
--// Sp1, Sp2 : Integer;
--//
--// procedure Call (Data1 : in Parm1;
--// Data2 : in Parm2) is
--// begin
--// Sp2 := Get_A7;
--// end Call;
--//
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--//
--// Sp1 := Get_A7;
--// Call (Data1, Data2);
--// Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A1, Sp1 - Sp2);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A1);
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Proc_In_In;
--//
--/ end if; -- Cdf_Hpux
--\f
------------------------------------------------------------------------------
-- Procedure with 2 In parameters.
------------------------------------------------------------------------------
--/ if TeleGen2 and then Unix then
--//
--// package body Proc_In_In is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// procedure Invoke_Subprog (Subprog : System.Address;
--// A4 : System.Address;
--// Arg1 : System.Address);
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Linkname (Invoke_Subprog, "_Xlbmt_In_Invoke_Procedure");
--//
--// function Get_A4 return System.Address;
--// pragma Interface (Assembly, Get_A4);
--// pragma Linkname (Get_A4, "_Xlbmt_Get_A4");
--//
--// procedure Call (Pvv : Pv;
--// Data1 : in Parm1;
--// Data2 : in Parm2) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A4, Pvv'Address);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A4 );
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Proc_In_In;
--//
--/ end if; -- TeleGen2 and then Unix
--\f
------------------------------------------------------------------------------
-- Procedure with 3 In parameters.
------------------------------------------------------------------------------
--/ if R1000 then
package body Proc_In_In_In is
Signature : constant X_Procedure_Signature :=
X_Unique_Procedure_Signature;
Signature1 : constant Long_Integer :=
Long_Integer (Signature.First) * 2 ** 31 +
Long_Integer (Signature.Second);
procedure Call (Pvv : Pv;
Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3) is
Pvvv : Subprogram_Implementation.Subprogram_Type;
Offset : constant Si.Offset_Vector :=
(Pvvv'Offset, Data1'Offset, Data2'Offset, Data3'Offset);
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Pvvv := Pvv.Data.Subprog;
Si.Invoke (Modes_Proc_In_In_In, Offset);
end Call;
function Value return Pv is
Pdr : X_Procedure_Data;
Pvr : X_Procedure_Variable;
begin
Pdr := new X_Procedure_Data_Rec'
(Key => Magic_Value,
Sig => Signature,
Subprog => Si.Get (Modes_Proc_In_In_In, Signature1));
Pvr := new X_Procedure_Variable_Rec'
(Key => Magic_Value,
Data => Pdr);
return Pv (Pvr);
exception
when others =>
Heap_Free_X_Procedure_Data (Pdr);
Heap_Free_X_Procedure_Variable (Pvr);
raise;
end Value;
procedure Free (Pvv : in out Pv) is
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
end Free;
function To_Pv (Pvv : X_Procedure_Variable) return Pv is
begin
if Pvv = None_X_Procedure_Variable then
return None;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return Pv (Pvv);
end To_Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable is
begin
if Pvv = None then
return None_X_Procedure_Variable;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return X_Procedure_Variable (Pvv);
end From_Pv;
end Proc_In_In_In;
--/ end if; -- R1000
--\f
------------------------------------------------------------------------------
-- Procedure with 3 In parameters.
------------------------------------------------------------------------------
--/ if Cdf_Hpux then
--//
--// package body Proc_In_In_In is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// procedure Invoke_Subprog (Subprog : System.Address;
--// A1 : System.Address;
--// Offset : Integer);
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Import_Procedure (Internal => Invoke_Subprog,
--// External => "__Xlbmt_In_Invoke_Procedure",
--// Parameter_Types => (System.Address,
--// System.Address, Integer),
--// Mechanism => (Value, Value, Value));
--//
--// function Get_A7 return Integer;
--// pragma Interface (Assembly, Get_A7);
--// pragma Import_Function (Internal => Get_A7,
--// External => "__Xlbmt_Get_A7",
--// Parameter_Types => null,
--// Result_Type => Integer);
--//
--// function Get_A1 return System.Address;
--// pragma Interface (Assembly, Get_A1);
--// pragma Import_Function (Internal => Get_A1,
--// External => "__Xlbmt_Get_A1",
--// Parameter_Types => null,
--// Result_Type => System.Address);
--//
--// procedure Call (Pvv : Pv;
--// Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : in Parm3) is
--// Sp1, Sp2 : Integer;
--//
--// procedure Call (Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : in Parm3) is
--// begin
--// Sp2 := Get_A7;
--// end Call;
--//
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--//
--// Sp1 := Get_A7;
--// Call (Data1, Data2, Data3);
--// Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A1, Sp1 - Sp2);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A1);
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Proc_In_In_In;
--//
--/ end if; -- Cdf_Hpux
--\f
------------------------------------------------------------------------------
-- Procedure with 3 In parameters.
------------------------------------------------------------------------------
--/ if TeleGen2 and then Unix then
--//
--// package body Proc_In_In_In is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// procedure Invoke_Subprog (Subprog : System.Address;
--// A4 : System.Address;
--// Arg1 : System.Address);
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Linkname (Invoke_Subprog, "_Xlbmt_In_Invoke_Procedure");
--//
--// function Get_A4 return System.Address;
--// pragma Interface (Assembly, Get_A4);
--// pragma Linkname (Get_A4, "_Xlbmt_Get_A4");
--//
--// procedure Call (Pvv : Pv;
--// Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : in Parm3) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A4, Pvv'Address);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A4 );
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Proc_In_In_In;
--//
--/ end if; -- TeleGen2 and then Unix
--\f
------------------------------------------------------------------------------
-- Procedure with 4 In parameters.
------------------------------------------------------------------------------
--/ if R1000 then
package body Proc_In_In_In_In is
Signature : constant X_Procedure_Signature :=
X_Unique_Procedure_Signature;
Signature1 : constant Long_Integer :=
Long_Integer (Signature.First) * 2 ** 31 +
Long_Integer (Signature.Second);
procedure Call (Pvv : Pv;
Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3;
Data4 : in Parm4) is
Pvvv : Subprogram_Implementation.Subprogram_Type;
Offset : constant Si.Offset_Vector :=
(Pvvv'Offset, Data1'Offset, Data2'Offset,
Data3'Offset, Data4'Offset);
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Pvvv := Pvv.Data.Subprog;
Si.Invoke (Modes_Proc_In_In_In_In, Offset);
end Call;
function Value return Pv is
Pdr : X_Procedure_Data;
Pvr : X_Procedure_Variable;
begin
Pdr := new X_Procedure_Data_Rec'
(Key => Magic_Value,
Sig => Signature,
Subprog => Si.Get
(Modes_Proc_In_In_In_In, Signature1));
Pvr := new X_Procedure_Variable_Rec'
(Key => Magic_Value,
Data => Pdr);
return Pv (Pvr);
exception
when others =>
Heap_Free_X_Procedure_Data (Pdr);
Heap_Free_X_Procedure_Variable (Pvr);
raise;
end Value;
procedure Free (Pvv : in out Pv) is
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
end Free;
function To_Pv (Pvv : X_Procedure_Variable) return Pv is
begin
if Pvv = None_X_Procedure_Variable then
return None;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return Pv (Pvv);
end To_Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable is
begin
if Pvv = None then
return None_X_Procedure_Variable;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return X_Procedure_Variable (Pvv);
end From_Pv;
end Proc_In_In_In_In;
--/ end if; -- R1000
--\f
------------------------------------------------------------------------------
-- Procedure with 4 In parameters.
------------------------------------------------------------------------------
--/ if Cdf_Hpux then
--//
--// package body Proc_In_In_In_In is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// procedure Invoke_Subprog (Subprog : System.Address;
--// A1 : System.Address;
--// Offset : Integer);
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Import_Procedure (Internal => Invoke_Subprog,
--// External => "__Xlbmt_In_Invoke_Procedure",
--// Parameter_Types => (System.Address,
--// System.Address, Integer),
--// Mechanism => (Value, Value, Value));
--//
--// function Get_A7 return Integer;
--// pragma Interface (Assembly, Get_A7);
--// pragma Import_Function (Internal => Get_A7,
--// External => "__Xlbmt_Get_A7",
--// Parameter_Types => null,
--// Result_Type => Integer);
--//
--// function Get_A1 return System.Address;
--// pragma Interface (Assembly, Get_A1);
--// pragma Import_Function (Internal => Get_A1,
--// External => "__Xlbmt_Get_A1",
--// Parameter_Types => null,
--// Result_Type => System.Address);
--//
--// procedure Call (Pvv : Pv;
--// Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : in Parm3;
--// Data4 : in Parm4) is
--// Sp1, Sp2 : Integer;
--//
--// procedure Call (Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : in Parm3;
--// Data4 : in Parm4) is
--// begin
--// Sp2 := Get_A7;
--// end Call;
--//
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--//
--// Sp1 := Get_A7;
--// Call (Data1, Data2, Data3, Data4);
--// Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A1, Sp1 - Sp2);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A1);
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Proc_In_In_In_In;
--//
--/ end if; -- Cdf_Hpux
--\f
------------------------------------------------------------------------------
-- Procedure with 4 In parameters.
------------------------------------------------------------------------------
--/ if TeleGen2 and then Unix then
--//
--// package body Proc_In_In_In_In is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// procedure Invoke_Subprog (Subprog : System.Address;
--// A4 : System.Address;
--// Arg1 : System.Address);
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Linkname (Invoke_Subprog, "_Xlbmt_In_Invoke_Procedure");
--//
--// function Get_A4 return System.Address;
--// pragma Interface (Assembly, Get_A4);
--// pragma Linkname (Get_A4, "_Xlbmt_Get_A4");
--//
--// procedure Call (Pvv : Pv;
--// Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : in Parm3;
--// Data4 : in Parm4) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A4, Pvv'Address);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A4 );
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Proc_In_In_In_In;
--//
--/ end if; -- TeleGen2 and then Unix
--\f
------------------------------------------------------------------------------
-- Procedure with 10 In parameters.
------------------------------------------------------------------------------
--/ if R1000 then
package body Proc_In10 is
Signature : constant X_Procedure_Signature :=
X_Unique_Procedure_Signature;
Signature1 : constant Long_Integer :=
Long_Integer (Signature.First) * 2 ** 31 +
Long_Integer (Signature.Second);
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) is
Pvvv : Subprogram_Implementation.Subprogram_Type;
Offset : constant Si.Offset_Vector :=
(Pvvv'Offset, Data1'Offset, Data2'Offset, Data3'Offset,
Data4'Offset, Data5'Offset, Data6'Offset, Data7'Offset,
Data8'Offset, Data9'Offset, Data10'Offset);
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Pvvv := Pvv.Data.Subprog;
Si.Invoke (Modes_Proc_In10, Offset);
end Call;
function Value return Pv is
Pdr : X_Procedure_Data;
Pvr : X_Procedure_Variable;
begin
Pdr := new X_Procedure_Data_Rec'
(Key => Magic_Value,
Sig => Signature,
Subprog => Si.Get (Modes_Proc_In10, Signature1));
Pvr := new X_Procedure_Variable_Rec'
(Key => Magic_Value,
Data => Pdr);
return Pv (Pvr);
exception
when others =>
Heap_Free_X_Procedure_Data (Pdr);
Heap_Free_X_Procedure_Variable (Pvr);
raise;
end Value;
procedure Free (Pvv : in out Pv) is
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
end Free;
function To_Pv (Pvv : X_Procedure_Variable) return Pv is
begin
if Pvv = None_X_Procedure_Variable then
return None;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return Pv (Pvv);
end To_Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable is
begin
if Pvv = None then
return None_X_Procedure_Variable;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return X_Procedure_Variable (Pvv);
end From_Pv;
end Proc_In10;
--/ end if; -- R1000
--\f
------------------------------------------------------------------------------
-- Procedure with 10 In parameters.
------------------------------------------------------------------------------
--/ if Cdf_Hpux then
--//
--// package body Proc_In10 is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// procedure Invoke_Subprog (Subprog : System.Address;
--// A1 : System.Address;
--// Offset : Integer);
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Import_Procedure (Internal => Invoke_Subprog,
--// External => "__Xlbmt_In_Invoke_Procedure",
--// Parameter_Types => (System.Address,
--// System.Address, Integer),
--// Mechanism => (Value, Value, Value));
--//
--// function Get_A7 return Integer;
--// pragma Interface (Assembly, Get_A7);
--// pragma Import_Function (Internal => Get_A7,
--// External => "__Xlbmt_Get_A7",
--// Parameter_Types => null,
--// Result_Type => Integer);
--//
--// function Get_A1 return System.Address;
--// pragma Interface (Assembly, Get_A1);
--// pragma Import_Function (Internal => Get_A1,
--// External => "__Xlbmt_Get_A1",
--// Parameter_Types => null,
--// Result_Type => System.Address);
--//
--// 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) is
--// Sp1, Sp2 : Integer;
--//
--// procedure Call (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) is
--// begin
--// Sp2 := Get_A7;
--// end Call;
--//
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--//
--// Sp1 := Get_A7;
--// Call (Data1, Data2, Data3, Data4, Data5,
--// Data6, Data7, Data8, Data9, Data10);
--// Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A1, Sp1 - Sp2);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A1);
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Proc_In10;
--//
--/ end if; -- Cdf_Hpux
--\f
------------------------------------------------------------------------------
-- Procedure with 10 In parameters.
------------------------------------------------------------------------------
--/ if TeleGen2 and then Unix then
--//
--// package body Proc_In10 is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// procedure Invoke_Subprog (Subprog : System.Address;
--// A4 : System.Address;
--// Arg1 : System.Address);
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Linkname (Invoke_Subprog, "_Xlbmt_In_Invoke_Procedure");
--//
--// function Get_A4 return System.Address;
--// pragma Interface (Assembly, Get_A4);
--// pragma Linkname (Get_A4, "_Xlbmt_Get_A4");
--//
--// 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) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A4, Pvv'Address);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A4 );
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Proc_In10;
--//
--/ end if; -- TeleGen2 and then Unix
--\f
------------------------------------------------------------------------------
-- Procedure with 3 In parameters and 2 Out parameters.
------------------------------------------------------------------------------
--/ if R1000 then
package body Proc_In_In_In_Out_Out is
Signature : constant X_Procedure_Signature :=
X_Unique_Procedure_Signature;
Signature1 : constant Long_Integer :=
Long_Integer (Signature.First) * 2 ** 31 +
Long_Integer (Signature.Second);
procedure Call (Pvv : Pv;
Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3;
Data4 : out Parm4;
Data5 : out Parm5) is
Pvvv : Subprogram_Implementation.Subprogram_Type;
Offset : constant Si.Offset_Vector :=
(Pvvv'Offset, Data1'Offset, Data2'Offset,
Data3'Offset, Data4'Offset, Data5'Offset);
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Pvvv := Pvv.Data.Subprog;
Si.Invoke (Modes_Proc_In_In_In_Out_Out, Offset);
end Call;
function Value return Pv is
Pdr : X_Procedure_Data;
Pvr : X_Procedure_Variable;
begin
Pdr := new X_Procedure_Data_Rec'
(Key => Magic_Value,
Sig => Signature,
Subprog => Si.Get (Modes_Proc_In_In_In_Out_Out,
Signature1));
Pvr := new X_Procedure_Variable_Rec'
(Key => Magic_Value,
Data => Pdr);
return Pv (Pvr);
exception
when others =>
Heap_Free_X_Procedure_Data (Pdr);
Heap_Free_X_Procedure_Variable (Pvr);
raise;
end Value;
procedure Free (Pvv : in out Pv) is
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
end Free;
function To_Pv (Pvv : X_Procedure_Variable) return Pv is
begin
if Pvv = None_X_Procedure_Variable then
return None;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return Pv (Pvv);
end To_Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable is
begin
if Pvv = None then
return None_X_Procedure_Variable;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return X_Procedure_Variable (Pvv);
end From_Pv;
end Proc_In_In_In_Out_Out;
--/ end if; -- R1000
--\f
------------------------------------------------------------------------------
-- Procedure with 3 In parameters and 2 Out parameters.
------------------------------------------------------------------------------
--/ if Cdf_Hpux then
--//
--// package body Proc_In_In_In_Out_Out is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// procedure Invoke_Subprog (Subprog : System.Address;
--// A1 : System.Address;
--// Offset : Integer);
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Import_Procedure (Internal => Invoke_Subprog,
--// External => "__Xlbmt_InOut_Invoke_Procedure",
--// Parameter_Types => (System.Address,
--// System.Address, Integer),
--// Mechanism => (Value, Value, Value));
--//
--// function Get_A7 return Integer;
--// pragma Interface (Assembly, Get_A7);
--// pragma Import_Function (Internal => Get_A7,
--// External => "__Xlbmt_Get_A7",
--// Parameter_Types => null,
--// Result_Type => Integer);
--//
--// function Get_A1 return System.Address;
--// pragma Interface (Assembly, Get_A1);
--// pragma Import_Function (Internal => Get_A1,
--// External => "__Xlbmt_Get_A1",
--// Parameter_Types => null,
--// Result_Type => System.Address);
--//
--// procedure Call (Pvv : Pv;
--// Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : in Parm3;
--// Data4 : out Parm4;
--// Data5 : out Parm5) is
--// Sp1, Sp2 : Integer;
--//
--// procedure Call (Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : in Parm3;
--// Data4 : out Parm4;
--// Data5 : out Parm5) is
--// begin
--// Sp2 := Get_A7;
--// end Call;
--//
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--//
--// Sp1 := Get_A7;
--// Call (Data1, Data2, Data3, Data4, Data5);
--// Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A1, Sp1 - Sp2);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A1);
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Proc_In_In_In_Out_Out;
--//
--/ end if; -- Cdf_Hpux
--\f
------------------------------------------------------------------------------
-- Procedure with 3 In parameters and 2 Out parameters.
------------------------------------------------------------------------------
--/ if TeleGen2 and then Unix then
--//
--// package body Proc_In_In_In_Out_Out is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// procedure Invoke_Subprog (Subprog : System.Address;
--// A4 : System.Address;
--// Arg1 : System.Address);
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Linkname (Invoke_Subprog, "_Xlbmt_InOut_Invoke_Procedure");
--//
--// function Get_A4 return System.Address;
--// pragma Interface (Assembly, Get_A4);
--// pragma Linkname (Get_A4, "_Xlbmt_Get_A4");
--//
--// procedure Call (Pvv : Pv;
--// Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : in Parm3;
--// Data4 : out Parm4;
--// Data5 : out Parm5) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A4, Pvv'Address);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A4 );
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return none;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Proc_In_In_In_Out_Out;
--//
--/ end if; -- TeleGen2 and then Unix
--\f
------------------------------------------------------------------------------
-- Procedure with 2 In parameters and 2 Out parameters.
------------------------------------------------------------------------------
--/ if R1000 then
package body Proc_In_In_Out_Out is
Signature : constant X_Procedure_Signature :=
X_Unique_Procedure_Signature;
Signature1 : constant Long_Integer :=
Long_Integer (Signature.First) * 2 ** 31 +
Long_Integer (Signature.Second);
procedure Call (Pvv : Pv;
Data1 : in Parm1;
Data2 : in Parm2;
Data3 : out Parm3;
Data4 : out Parm4) is
Pvvv : Subprogram_Implementation.Subprogram_Type;
Offset : constant Si.Offset_Vector :=
(Pvvv'Offset, Data1'Offset, Data2'Offset,
Data3'Offset, Data4'Offset);
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Pvvv := Pvv.Data.Subprog;
Si.Invoke (Modes_Proc_In_In_Out_Out, Offset);
end Call;
function Value return Pv is
Pdr : X_Procedure_Data;
Pvr : X_Procedure_Variable;
begin
Pdr := new X_Procedure_Data_Rec'
(Key => Magic_Value,
Sig => Signature,
Subprog => Si.Get (Modes_Proc_In_In_Out_Out,
Signature1));
Pvr := new X_Procedure_Variable_Rec'
(Key => Magic_Value,
Data => Pdr);
return Pv (Pvr);
exception
when others =>
Heap_Free_X_Procedure_Data (Pdr);
Heap_Free_X_Procedure_Variable (Pvr);
raise;
end Value;
procedure Free (Pvv : in out Pv) is
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
end Free;
function To_Pv (Pvv : X_Procedure_Variable) return Pv is
begin
if Pvv = None_X_Procedure_Variable then
return None;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return Pv (Pvv);
end To_Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable is
begin
if Pvv = None then
return None_X_Procedure_Variable;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return X_Procedure_Variable (Pvv);
end From_Pv;
end Proc_In_In_Out_Out;
--/ end if; -- R1000
--\f
------------------------------------------------------------------------------
-- Procedure with 2 In parameters and 2 Out parameters.
------------------------------------------------------------------------------
--/ if Cdf_Hpux then
--//
--// package body Proc_In_In_Out_Out is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// procedure Invoke_Subprog (Subprog : System.Address;
--// A1 : System.Address;
--// Offset : Integer);
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Import_Procedure (Internal => Invoke_Subprog,
--// External => "__Xlbmt_InOut_Invoke_Procedure",
--// Parameter_Types => (System.Address,
--// System.Address, Integer),
--// Mechanism => (Value, Value, Value));
--//
--// function Get_A7 return Integer;
--// pragma Interface (Assembly, Get_A7);
--// pragma Import_Function (Internal => Get_A7,
--// External => "__Xlbmt_Get_A7",
--// Parameter_Types => null,
--// Result_Type => Integer);
--//
--// function Get_A1 return System.Address;
--// pragma Interface (Assembly, Get_A1);
--// pragma Import_Function (Internal => Get_A1,
--// External => "__Xlbmt_Get_A1",
--// Parameter_Types => null,
--// Result_Type => System.Address);
--//
--// procedure Call (Pvv : Pv;
--// Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : out Parm3;
--// Data4 : out Parm4) is
--// Sp1, Sp2 : Integer;
--//
--// procedure Call (Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : out Parm3;
--// Data4 : out Parm4) is
--// begin
--// Sp2 := Get_A7;
--// end Call;
--//
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--//
--// Sp1 := Get_A7;
--// Call (Data1, Data2, Data3, Data4);
--// Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A1, Sp1 - Sp2);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A1);
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Proc_In_In_Out_Out;
--//
--/ end if; -- Cdf_Hpux
--\f
------------------------------------------------------------------------------
-- Procedure with 2 In parameters and 2 Out parameters.
------------------------------------------------------------------------------
--/ if TeleGen2 and then Unix then
--//
--// package body Proc_In_In_Out_Out is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// procedure Invoke_Subprog (Subprog : System.Address;
--// A4 : System.Address;
--// Arg1 : System.Address);
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Linkname (Invoke_Subprog, "_Xlbmt_InOut_Invoke_Procedure");
--//
--// function Get_A4 return System.Address;
--// pragma Interface (Assembly, Get_A4);
--// pragma Linkname (Get_A4, "_Xlbmt_Get_A4");
--//
--// procedure Call (Pvv : Pv;
--// Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : out Parm3;
--// Data4 : out Parm4) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A4, Pvv'Address);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A4 );
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Proc_In_In_Out_Out;
--//
--/ end if; -- TeleGen2 and then Unix
--\f
------------------------------------------------------------------------------
-- Function with 1 In parameter.
------------------------------------------------------------------------------
--/ if R1000 then
package body Func_In is
Force_Constrained_Type : Ret; -- Forces Ret type to be a fully
-- constrained type; LRM 12.3.2 (4).
Signature : constant X_Procedure_Signature :=
X_Unique_Procedure_Signature;
Signature1 : constant Long_Integer :=
Long_Integer (Signature.First) * 2 ** 31 +
Long_Integer (Signature.Second);
function Call (Pvv : Pv;
Data : in Parm1) return Ret is
Return_Value : Ret;
Pvvv : Subprogram_Implementation.Subprogram_Type;
Offset : constant Si.Offset_Vector :=
(Pvvv'Offset, Data'Offset, Return_Value'Offset);
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Pvvv := Pvv.Data.Subprog;
Si.Invoke (Modes_Func_In, Offset);
return Return_Value;
end Call;
function Value return Pv is
Pdr : X_Procedure_Data;
Pvr : X_Procedure_Variable;
begin
Pdr := new X_Procedure_Data_Rec'
(Key => Magic_Value,
Sig => Signature,
Subprog => Si.Get (Modes_Func_In, Signature1));
Pvr := new X_Procedure_Variable_Rec'
(Key => Magic_Value,
Data => Pdr);
return Pv (Pvr);
exception
when others =>
Heap_Free_X_Procedure_Data (Pdr);
Heap_Free_X_Procedure_Variable (Pvr);
raise;
end Value;
procedure Free (Pvv : in out Pv) is
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
end Free;
function To_Pv (Pvv : X_Procedure_Variable) return Pv is
begin
if Pvv = None_X_Procedure_Variable then
return None;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return Pv (Pvv);
end To_Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable is
begin
if Pvv = None then
return None_X_Procedure_Variable;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return X_Procedure_Variable (Pvv);
end From_Pv;
end Func_In;
--/ end if; -- R1000
--\f
------------------------------------------------------------------------------
-- Function with 1 In parameter.
------------------------------------------------------------------------------
--/ if Cdf_Hpux then
--//
--// package body Func_In is
--//
--// Force_Constrained_Type : Ret; -- Forces Ret type to be a fully
--// -- constrained type; LRM 12.3.2 (4).
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// function Invoke_Subprog (Subprog : System.Address;
--// A1 : System.Address;
--// Offset : Integer) return Ret;
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Import_Function
--// (Internal => Invoke_Subprog,
--// External => "__Xlbmt_InOut_Invoke_Function",
--// Parameter_Types => (System.Address, System.Address, Integer),
--// Mechanism => (Value, Value, Value),
--// Result_Type => Ret);
--//
--// function Get_A7 return Integer;
--// pragma Interface (Assembly, Get_A7);
--// pragma Import_Function (Internal => Get_A7,
--// External => "__Xlbmt_Get_A7",
--// Parameter_Types => null,
--// Result_Type => Integer);
--//
--// function Get_A1 return System.Address;
--// pragma Interface (Assembly, Get_A1);
--// pragma Import_Function (Internal => Get_A1,
--// External => "__Xlbmt_Get_A1",
--// Parameter_Types => null,
--// Result_Type => System.Address);
--//
--// function Call (Pvv : Pv; Data : in Parm1) return Ret is
--// Sp1, Sp2 : Integer;
--//
--// procedure Call (Data : in Parm1) is
--// begin
--// Sp2 := Get_A7;
--// end Call;
--//
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--//
--// Sp1 := Get_A7;
--// Call (Data);
--// return Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A1, Sp1 - Sp2);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A1);
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Func_In;
--//
--/ end if; -- Cdf_Hpux
--\f
------------------------------------------------------------------------------
-- Function with 1 In parameter.
------------------------------------------------------------------------------
--/ if TeleGen2 and then Unix then
--//
--// package body Func_In is
--//
--// Force_Constrained_Type : Ret; -- Forces Ret type to be a fully
--// -- constrained type; LRM 12.3.2 (4).
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// function Invoke_Subprog (Subprog : System.Address;
--// A4 : System.Address;
--// Arg1 : System.Address) return Ret;
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Linkname (Invoke_Subprog, "_Xlbmt_Invoke_Function");
--//
--// function Get_A4 return System.Address;
--// pragma Interface (Assembly, Get_A4);
--// pragma Linkname (Get_A4, "_Xlbmt_Get_A4");
--//
--// function Call (Pvv : Pv;
--// Data : in Parm1) return Ret is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A4, Pvv'Address);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A4 );
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Func_In;
--//
--/ end if; -- TeleGen2 and then Unix
--\f
------------------------------------------------------------------------------
-- Function with 1 In parameter return String.
------------------------------------------------------------------------------
--/ if R1000 then
package body Func_In_X_String is
Signature : constant X_Procedure_Signature :=
X_Unique_Procedure_Signature;
Signature1 : constant Long_Integer :=
Long_Integer (Signature.First) * 2 ** 31 +
Long_Integer (Signature.Second);
function Call (Pvv : Pv;
Data1 : in Parm1) return X_String is
Return_Value : constant X_String := String_Placeholder;
Pvvv : Subprogram_Implementation.Subprogram_Type;
Offset : constant Si.Offset_Vector :=
(Pvvv'Offset, Data1'Offset, Return_Value'Offset);
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Pvvv := Pvv.Data.Subprog;
Si.Invoke (Modes_Func_In_X_String, Offset);
return Return_Value;
end Call;
function Value return Pv is
Pdr : X_Procedure_Data;
Pvr : X_Procedure_Variable;
begin
Pdr := new X_Procedure_Data_Rec'
(Key => Magic_Value,
Sig => Signature,
Subprog => Si.Get
(Modes_Func_In_X_String, Signature1));
Pvr := new X_Procedure_Variable_Rec'
(Key => Magic_Value,
Data => Pdr);
return Pv (Pvr);
exception
when others =>
Heap_Free_X_Procedure_Data (Pdr);
Heap_Free_X_Procedure_Variable (Pvr);
raise;
end Value;
procedure Free (Pvv : in out Pv) is
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
end Free;
function To_Pv (Pvv : X_Procedure_Variable) return Pv is
begin
if Pvv = None_X_Procedure_Variable then
return None;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return Pv (Pvv);
end To_Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable is
begin
if Pvv = None then
return None_X_Procedure_Variable;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return X_Procedure_Variable (Pvv);
end From_Pv;
end Func_In_X_String;
--/ end if; -- R1000
--\f
------------------------------------------------------------------------------
-- Function with 1 In parameter return String.
------------------------------------------------------------------------------
--/ if Cdf_Hpux then
--//
--// package body Func_In_X_String is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// function Invoke_Subprog (Subprog : System.Address;
--// A1 : System.Address;
--// Offset : Integer) return X_String;
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Import_Function (Internal => Invoke_Subprog,
--// External => "__Xlbmt_InOut_Invoke_Function",
--// Parameter_Types => (System.Address,
--// System.Address, Integer),
--// Mechanism => (Value, Value, Value),
--// Result_Type => X_String);
--//
--// function Get_A7 return Integer;
--// pragma Interface (Assembly, Get_A7);
--// pragma Import_Function (Internal => Get_A7,
--// External => "__Xlbmt_Get_A7",
--// Parameter_Types => null,
--// Result_Type => Integer);
--//
--// function Get_A1 return System.Address;
--// pragma Interface (Assembly, Get_A1);
--// pragma Import_Function (Internal => Get_A1,
--// External => "__Xlbmt_Get_A1",
--// Parameter_Types => null,
--// Result_Type => System.Address);
--//
--// function Call (Pvv : Pv; Data1 : in Parm1) return X_String is
--// Sp1, Sp2 : Integer;
--//
--// procedure Call (Data1 : in Parm1) is
--// begin
--// Sp2 := Get_A7;
--// end Call;
--//
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--//
--// Sp1 := Get_A7;
--// Call (Data1);
--// return Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A1, Sp1 - Sp2);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A1);
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Func_In_X_String;
--//
--/ end if; -- Cdf_Hpux
--\f
------------------------------------------------------------------------------
-- Function with 1 In parameter return String.
------------------------------------------------------------------------------
--/ if TeleGen2 and then Unix then
--//
--// package body Func_In_X_String is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// function Invoke_Subprog (Subprog : System.Address;
--// A4 : System.Address;
--// Arg1 : System.Address) return X_String;
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Linkname (Invoke_Subprog, "_Xlbmt_Invoke_String_Function");
--//
--// function Get_A4 return System.Address;
--// pragma Interface (Assembly, Get_A4);
--// pragma Linkname (Get_A4, "_Xlbmt_Get_A4");
--//
--// function Call (Pvv : Pv;
--// Data1 : in Parm1) return X_String is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A4, Pvv'Address);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A4 );
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Func_In_X_String;
--//
--/ end if; -- TeleGen2 and then Unix
--\f
------------------------------------------------------------------------------
-- Function with 3 In parameters return String.
------------------------------------------------------------------------------
--/ if R1000 then
package body Func_In_In_In_X_String is
Signature : constant X_Procedure_Signature :=
X_Unique_Procedure_Signature;
Signature1 : constant Long_Integer :=
Long_Integer (Signature.First) * 2 ** 31 +
Long_Integer (Signature.Second);
function Call (Pvv : Pv;
Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3) return X_String is
Return_Value : constant X_String := String_Placeholder;
Pvvv : Subprogram_Implementation.Subprogram_Type;
Offset : constant Si.Offset_Vector :=
(Pvvv'Offset, Data1'Offset, Data2'Offset,
Data3'Offset, Return_Value'Offset);
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Pvvv := Pvv.Data.Subprog;
Si.Invoke (Modes_Func_In_In_In_X_String, Offset);
return Return_Value;
end Call;
function Value return Pv is
Pdr : X_Procedure_Data;
Pvr : X_Procedure_Variable;
begin
Pdr := new X_Procedure_Data_Rec'
(Key => Magic_Value,
Sig => Signature,
Subprog => Si.Get (Modes_Func_In_In_In, Signature1));
Pvr := new X_Procedure_Variable_Rec'
(Key => Magic_Value,
Data => Pdr);
return Pv (Pvr);
exception
when others =>
Heap_Free_X_Procedure_Data (Pdr);
Heap_Free_X_Procedure_Variable (Pvr);
raise;
end Value;
procedure Free (Pvv : in out Pv) is
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
end Free;
function To_Pv (Pvv : X_Procedure_Variable) return Pv is
begin
if Pvv = None_X_Procedure_Variable then
return None;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return Pv (Pvv);
end To_Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable is
begin
if Pvv = None then
return None_X_Procedure_Variable;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return X_Procedure_Variable (Pvv);
end From_Pv;
end Func_In_In_In_X_String;
--/ end if; -- R1000
--\f
------------------------------------------------------------------------------
-- Function with 3 In parameters return String.
------------------------------------------------------------------------------
--/ if Cdf_Hpux then
--//
--// package body Func_In_In_In_X_String is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// function Invoke_Subprog (Subprog : System.Address;
--// A1 : System.Address;
--// Offset : Integer) return X_String;
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Import_Function (Internal => Invoke_Subprog,
--// External => "__Xlbmt_InOut_Invoke_Function",
--// Parameter_Types => (System.Address,
--// System.Address, Integer),
--// Mechanism => (Value, Value, Value),
--// Result_Type => X_String);
--//
--// function Get_A7 return Integer;
--// pragma Interface (Assembly, Get_A7);
--// pragma Import_Function (Internal => Get_A7,
--// External => "__Xlbmt_Get_A7",
--// Parameter_Types => null,
--// Result_Type => Integer);
--//
--// function Get_A1 return System.Address;
--// pragma Interface (Assembly, Get_A1);
--// pragma Import_Function (Internal => Get_A1,
--// External => "__Xlbmt_Get_A1",
--// Parameter_Types => null,
--// Result_Type => System.Address);
--//
--// function Call (Pvv : Pv;
--// Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : in Parm3) return X_String is
--// Sp1, Sp2 : Integer;
--//
--// procedure Call (Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : in Parm3) is
--// begin
--// Sp2 := Get_A7;
--// end Call;
--//
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--//
--// Sp1 := Get_A7;
--// Call (Data1, Data2, Data3);
--// return Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A1, Sp1 - Sp2);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A1);
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Func_In_In_In_X_String;
--//
--/ end if; -- Cdf_Hpux
--\f
------------------------------------------------------------------------------
-- Function with 3 In parameters return String.
------------------------------------------------------------------------------
--/ if TeleGen2 and then Unix then
--//
--// package body Func_In_In_In_X_String is
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// function Invoke_Subprog (Subprog : System.Address;
--// A4 : System.Address;
--// Arg1 : System.Address) return X_String;
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Linkname (Invoke_Subprog, "_Xlbmt_Invoke_String_Function");
--//
--// function Get_A4 return System.Address;
--// pragma Interface (Assembly, Get_A4);
--// pragma Linkname (Get_A4, "_Xlbmt_Get_A4");
--//
--// function Call (Pvv : Pv;
--// Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : in Parm3) return X_String is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A4, Pvv'Address);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A4 );
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Func_In_In_In_X_String;
--//
--/ end if; -- TeleGen2 and then Unix
--\f
------------------------------------------------------------------------------
-- Function with 3 In parameters.
------------------------------------------------------------------------------
--/ if R1000 then
package body Func_In_In_In is
Force_Constrained_Type : Ret; -- Forces Ret type to be a fully
-- constrained type; LRM 12.3.2 (4).
Signature : constant X_Procedure_Signature :=
X_Unique_Procedure_Signature;
Signature1 : constant Long_Integer :=
Long_Integer (Signature.First) * 2 ** 31 +
Long_Integer (Signature.Second);
function Call (Pvv : Pv;
Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3) return Ret is
Return_Value : Ret;
Pvvv : Subprogram_Implementation.Subprogram_Type;
Offset : constant Si.Offset_Vector :=
(Pvvv'Offset, Data1'Offset, Data2'Offset,
Data3'Offset, Return_Value'Offset);
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Pvvv := Pvv.Data.Subprog;
Si.Invoke (Modes_Func_In_In_In, Offset);
return Return_Value;
end Call;
function Value return Pv is
Pdr : X_Procedure_Data;
Pvr : X_Procedure_Variable;
begin
Pdr := new X_Procedure_Data_Rec'
(Key => Magic_Value,
Sig => Signature,
Subprog => Si.Get (Modes_Func_In_In_In, Signature1));
Pvr := new X_Procedure_Variable_Rec'
(Key => Magic_Value,
Data => Pdr);
return Pv (Pvr);
exception
when others =>
Heap_Free_X_Procedure_Data (Pdr);
Heap_Free_X_Procedure_Variable (Pvr);
raise;
end Value;
procedure Free (Pvv : in out Pv) is
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
end Free;
function To_Pv (Pvv : X_Procedure_Variable) return Pv is
begin
if Pvv = None_X_Procedure_Variable then
return None;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return Pv (Pvv);
end To_Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable is
begin
if Pvv = None then
return None_X_Procedure_Variable;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return X_Procedure_Variable (Pvv);
end From_Pv;
end Func_In_In_In;
--/ end if; -- R1000
--\f
------------------------------------------------------------------------------
-- Function with 3 In parameters.
------------------------------------------------------------------------------
--/ if Cdf_Hpux then
--//
--// package body Func_In_In_In is
--//
--// Force_Constrained_Type : Ret; -- Forces Ret type to be a fully
--// -- constrained type; LRM 12.3.2 (4).
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// function Invoke_Subprog (Subprog : System.Address;
--// A1 : System.Address;
--// Offset : Integer) return Ret;
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Import_Function
--// (Internal => Invoke_Subprog,
--// External => "__Xlbmt_InOut_Invoke_Function",
--// Parameter_Types => (System.Address, System.Address, Integer),
--// Mechanism => (Value, Value, Value),
--// Result_Type => Ret);
--//
--// function Get_A7 return Integer;
--// pragma Interface (Assembly, Get_A7);
--// pragma Import_Function (Internal => Get_A7,
--// External => "__Xlbmt_Get_A7",
--// Parameter_Types => null,
--// Result_Type => Integer);
--//
--// function Get_A1 return System.Address;
--// pragma Interface (Assembly, Get_A1);
--// pragma Import_Function (Internal => Get_A1,
--// External => "__Xlbmt_Get_A1",
--// Parameter_Types => null,
--// Result_Type => System.Address);
--//
--// function Call (Pvv : Pv;
--// Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : in Parm3) return Ret is
--// Sp1, Sp2 : Integer;
--//
--// procedure Call (Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : in Parm3) is
--// begin
--// Sp2 := Get_A7;
--// end Call;
--//
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--//
--// Sp1 := Get_A7;
--// Call (Data1, Data2, Data3);
--// return Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A1, Sp1 - Sp2);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A1);
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Func_In_In_In;
--//
--/ end if; -- Cdf_Hpux
--\f
------------------------------------------------------------------------------
-- Function with 3 In parameters.
------------------------------------------------------------------------------
--/ if TeleGen2 and then Unix then
--//
--// package body Func_In_In_In is
--//
--// Force_Constrained_Type : Ret; -- Forces Ret type to be a fully
--// -- constrained type; LRM 12.3.2 (4).
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// function Invoke_Subprog (Subprog : System.Address;
--// A4 : System.Address;
--// Arg1 : System.Address) return Ret;
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Linkname (Invoke_Subprog, "_Xlbmt_Invoke_Function");
--//
--// function Get_A4 return System.Address;
--// pragma Interface (Assembly, Get_A4);
--// pragma Linkname (Get_A4, "_Xlbmt_Get_A4");
--//
--// function Call (Pvv : Pv;
--// Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : in Parm3) return Ret is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A4, Pvv'Address);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A4 );
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Func_In_In_In;
--//
--/ end if; -- TeleGen2 and then Unix
--\f
------------------------------------------------------------------------------
-- Function with 5 In parameters.
------------------------------------------------------------------------------
--/ if R1000 then
package body Func_In5 is
Force_Constrained_Type : Ret; -- Forces Ret type to be a fully
-- constrained type; LRM 12.3.2 (4).
Signature : constant X_Procedure_Signature :=
X_Unique_Procedure_Signature;
Signature1 : constant Long_Integer :=
Long_Integer (Signature.First) * 2 ** 31 +
Long_Integer (Signature.Second);
function Call (Pvv : Pv;
Data1 : in Parm1;
Data2 : in Parm2;
Data3 : in Parm3;
Data4 : in Parm4;
Data5 : in Parm5) return Ret is
Return_Value : Ret;
Pvvv : Subprogram_Implementation.Subprogram_Type;
Offset : constant Si.Offset_Vector :=
(Pvvv'Offset, Data1'Offset, Data2'Offset, Data3'Offset,
Data4'Offset, Data5'Offset, Return_Value'Offset);
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Pvvv := Pvv.Data.Subprog;
Si.Invoke (Modes_Func_In5, Offset);
return Return_Value;
end Call;
function Value return Pv is
Pdr : X_Procedure_Data;
Pvr : X_Procedure_Variable;
begin
Pdr := new X_Procedure_Data_Rec'
(Key => Magic_Value,
Sig => Signature,
Subprog => Si.Get (Modes_Func_In5, Signature1));
Pvr := new X_Procedure_Variable_Rec'
(Key => Magic_Value,
Data => Pdr);
return Pv (Pvr);
exception
when others =>
Heap_Free_X_Procedure_Data (Pdr);
Heap_Free_X_Procedure_Variable (Pvr);
raise;
end Value;
procedure Free (Pvv : in out Pv) is
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
end Free;
function To_Pv (Pvv : X_Procedure_Variable) return Pv is
begin
if Pvv = None_X_Procedure_Variable then
return None;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return Pv (Pvv);
end To_Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable is
begin
if Pvv = None then
return None_X_Procedure_Variable;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return X_Procedure_Variable (Pvv);
end From_Pv;
end Func_In5;
--/ end if; -- R1000
--\f
------------------------------------------------------------------------------
-- Function with 5 In parameters.
------------------------------------------------------------------------------
--/ if Cdf_Hpux then
--//
--// package body Func_In5 is
--//
--// Force_Constrained_Type : Ret; -- Forces Ret type to be a fully
--// -- constrained type; LRM 12.3.2 (4).
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// function Invoke_Subprog (Subprog : System.Address;
--// A1 : System.Address;
--// Offset : Integer) return Ret;
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Import_Function
--// (Internal => Invoke_Subprog,
--// External => "__Xlbmt_InOut_Invoke_Function",
--// Parameter_Types => (System.Address, System.Address, Integer),
--// Mechanism => (Value, Value, Value),
--// Result_Type => Ret);
--//
--// function Get_A7 return Integer;
--// pragma Interface (Assembly, Get_A7);
--// pragma Import_Function (Internal => Get_A7,
--// External => "__Xlbmt_Get_A7",
--// Parameter_Types => null,
--// Result_Type => Integer);
--//
--// function Get_A1 return System.Address;
--// pragma Interface (Assembly, Get_A1);
--// pragma Import_Function (Internal => Get_A1,
--// External => "__Xlbmt_Get_A1",
--// Parameter_Types => null,
--// Result_Type => System.Address);
--//
--// function Call (Pvv : Pv;
--// Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : in Parm3;
--// Data4 : in Parm4;
--// Data5 : in Parm5) return Ret is
--// Sp1, Sp2 : Integer;
--//
--// procedure Call (Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : in Parm3;
--// Data4 : in Parm4;
--// Data5 : in Parm5) is
--// begin
--// Sp2 := Get_A7;
--// end Call;
--//
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--//
--// Sp1 := Get_A7;
--// Call (Data1, Data2, Data3, Data4, Data5);
--// return Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A1, Sp1 - Sp2);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A1);
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Func_In5;
--//
--/ end if; -- Cdf_Hpux
--\f
------------------------------------------------------------------------------
-- Function with 5 In parameters.
------------------------------------------------------------------------------
--/ if TeleGen2 and then Unix then
--//
--// package body Func_In5 is
--//
--// Force_Constrained_Type : Ret; -- Forces Ret type to be a fully
--// -- constrained type; LRM 12.3.2 (4).
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// function Invoke_Subprog (Subprog : System.Address;
--// A4 : System.Address;
--// Arg1 : System.Address) return Ret;
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Linkname (Invoke_Subprog, "_Xlbmt_Invoke_Function");
--//
--// function Get_A4 return System.Address;
--// pragma Interface (Assembly, Get_A4);
--// pragma Linkname (Get_A4, "_Xlbmt_Get_A4");
--//
--// function Call (Pvv : Pv;
--// Data1 : in Parm1;
--// Data2 : in Parm2;
--// Data3 : in Parm3;
--// Data4 : in Parm4;
--// Data5 : in Parm5) return Ret is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A4, Pvv'Address);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A4 );
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Func_In5;
--//
--/ end if; -- TeleGen2 and then Unix
--\f
------------------------------------------------------------------------------
-- Function with 10 In parameters.
------------------------------------------------------------------------------
--/ if R1000 then
package body Func_In10 is
Force_Constrained_Type : Ret; -- Forces Ret type to be a fully
-- constrained type; LRM 12.3.2 (4).
Signature : constant X_Procedure_Signature :=
X_Unique_Procedure_Signature;
Signature1 : constant Long_Integer :=
Long_Integer (Signature.First) * 2 ** 31 +
Long_Integer (Signature.Second);
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 is
Return_Value : Ret;
Pvvv : Subprogram_Implementation.Subprogram_Type;
Offset : constant Si.Offset_Vector :=
(Pvvv'Offset, Data1'Offset, Data2'Offset, Data3'Offset,
Data4'Offset, Data5'Offset, Data6'Offset, Data7'Offset,
Data8'Offset, Data9'Offset, Data10'Offset, Return_Value'Offset);
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Pvvv := Pvv.Data.Subprog;
Si.Invoke (Modes_Func_In10, Offset);
return Return_Value;
end Call;
function Value return Pv is
Pdr : X_Procedure_Data;
Pvr : X_Procedure_Variable;
begin
Pdr := new X_Procedure_Data_Rec'
(Key => Magic_Value,
Sig => Signature,
Subprog => Si.Get (Modes_Func_In10, Signature1));
Pvr := new X_Procedure_Variable_Rec'
(Key => Magic_Value,
Data => Pdr);
return Pv (Pvr);
exception
when others =>
Heap_Free_X_Procedure_Data (Pdr);
Heap_Free_X_Procedure_Variable (Pvr);
raise;
end Value;
procedure Free (Pvv : in out Pv) is
begin
if Pvv = None or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
end Free;
function To_Pv (Pvv : X_Procedure_Variable) return Pv is
begin
if Pvv = None_X_Procedure_Variable then
return None;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return Pv (Pvv);
end To_Pv;
function From_Pv (Pvv : Pv) return X_Procedure_Variable is
begin
if Pvv = None then
return None_X_Procedure_Variable;
elsif Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value or else
Pvv.Data.Sig /= Signature then
raise X_Bad_Procedure_Variable;
end if;
return X_Procedure_Variable (Pvv);
end From_Pv;
end Func_In10;
--/ end if; -- R1000
--\f
------------------------------------------------------------------------------
-- Function with 10 In parameters.
------------------------------------------------------------------------------
--/ if Cdf_Hpux then
--//
--// package body Func_In10 is
--//
--// Force_Constrained_Type : Ret; -- Forces Ret type to be a fully
--// -- constrained type; LRM 12.3.2 (4).
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// function Invoke_Subprog (Subprog : System.Address;
--// A1 : System.Address;
--// Offset : Integer) return Ret;
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Import_Function
--// (Internal => Invoke_Subprog,
--// External => "__Xlbmt_InOut_Invoke_Function",
--// Parameter_Types => (System.Address, System.Address, Integer),
--// Mechanism => (Value, Value, Value),
--// Result_Type => Ret);
--//
--// function Get_A7 return Integer;
--// pragma Interface (Assembly, Get_A7);
--// pragma Import_Function (Internal => Get_A7,
--// External => "__Xlbmt_Get_A7",
--// Parameter_Types => null,
--// Result_Type => Integer);
--//
--// function Get_A1 return System.Address;
--// pragma Interface (Assembly, Get_A1);
--// pragma Import_Function (Internal => Get_A1,
--// External => "__Xlbmt_Get_A1",
--// Parameter_Types => null,
--// Result_Type => System.Address);
--//
--// 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 is
--// Sp1, Sp2 : Integer;
--//
--// procedure Call (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) is
--// begin
--// Sp2 := Get_A7;
--// end Call;
--//
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--//
--// Sp1 := Get_A7;
--// Call (Data1, Data2, Data3, Data4, Data5,
--// Data6, Data7, Data8, Data9, Data10);
--// return Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A1, Sp1 - Sp2);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A1);
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Func_In10;
--//
--/ end if; -- Cdf_Hpux
--\f
------------------------------------------------------------------------------
-- Function with 10 In parameters.
------------------------------------------------------------------------------
--/ if TeleGen2 and then Unix then
--//
--// package body Func_In10 is
--//
--// Force_Constrained_Type : Ret; -- Forces Ret type to be a fully
--// -- constrained type; LRM 12.3.2 (4).
--//
--// Signature : constant X_Procedure_Signature :=
--// X_Unique_Procedure_Signature;
--//
--// function Invoke_Subprog (Subprog : System.Address;
--// A4 : System.Address;
--// Arg1 : System.Address) return Ret;
--// pragma Interface (Assembly, Invoke_Subprog);
--// pragma Linkname (Invoke_Subprog, "_Xlbmt_Invoke_Function");
--//
--// function Get_A4 return System.Address;
--// pragma Interface (Assembly, Get_A4);
--// pragma Linkname (Get_A4, "_Xlbmt_Get_A4");
--//
--// 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 is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Invoke_Subprog (Pvv.Data.Subprog, Pvv.Data.A4, Pvv'Address);
--// end Call;
--//
--// function Value return Pv is
--// Pvr : X_Procedure_Variable;
--// begin
--// Pvr := New_Procedure_Data (Signature, Called'Address, Get_A4 );
--// return Pv (Pvr);
--// exception
--// when others =>
--// Heap_Free_X_Procedure_Data (Pvr.Data);
--// Heap_Free_X_Procedure_Variable (Pvr);
--// raise;
--// end Value;
--//
--// procedure Free (Pvv : in out Pv) is
--// begin
--// if Pvv = None or else
--// Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// Free_X_Procedure_Variable (X_Procedure_Variable (Pvv));
--// end Free;
--//
--// function To_Pv (Pvv : X_Procedure_Variable) return Pv is
--// begin
--// if Pvv = None_X_Procedure_Variable then
--// return None;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return Pv (Pvv);
--// end To_Pv;
--//
--// function From_Pv (Pvv : Pv) return X_Procedure_Variable is
--// begin
--// if Pvv = None then
--// return None_X_Procedure_Variable;
--// elsif Pvv.Key /= Magic_Value or else
--// Pvv.Data.Key /= Magic_Value or else
--// Pvv.Data.Sig /= Signature then
--// raise X_Bad_Procedure_Variable;
--// end if;
--// return X_Procedure_Variable (Pvv);
--// end From_Pv;
--//
--// end Func_In10;
--//
--/ end if; -- TeleGen2 and then Unix
--\f
function X_Procedure_Variable_Signature (Pvv : X_Procedure_Variable)
return X_Procedure_Signature is
------------------------------------------------------------------------------
-- Pvv - Specifies the procedure variable to use
--
-- Called to obtain the X_Signature value for the specified procedure
-- variable value. Note: The "None" procedure variable values do not have
-- an X_Signature value and will raise Constraint_Error.
------------------------------------------------------------------------------
begin
if Pvv = None_X_Procedure_Variable or else
Pvv.Key /= Magic_Value or else
Pvv.Data.Key /= Magic_Value then
raise X_Bad_Procedure_Variable;
end if;
return Pvv.Data.Sig;
end X_Procedure_Variable_Signature;
--\f
end Xlbt_Proc_Var;