|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 211968 (0x33c00)
Types: Ada Source
Notes: 03_class, FILE, Long Ada Source, R1k_Segment, e3_tag, package body Func_In, package body Func_In10, package body Func_In5, package body Func_In_In_In, package body Func_In_In_In_X_String, package body Func_In_X_String, package body Proc_In, package body Proc_In10, package body Proc_In_In, package body Proc_In_In_In, package body Proc_In_In_In_In, package body Proc_In_In_In_Out_Out, package body Proc_In_In_Out_Out, package body Proc_Inout, package body Xlbt_Proc_Var, seg_004f47
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦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.
------------------------------------------------------------------------------
--\x0c
------------------------------------------------------------------------------
-- 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);
--\x0c
------------------------------------------------------------------------------
-- 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;
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
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;
--\x0c
--/ 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;
--\x0c
--/ 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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
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;
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
------------------------------------------------------------------------------
-- 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
--\x0c
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;
--\x0c
end Xlbt_Proc_Var;
nblk1=ce
nid=ce
hdr6=19a
[0x00] rec0=23 rec1=00 rec2=01 rec3=068
[0x01] rec0=10 rec1=00 rec2=02 rec3=00c
[0x02] rec0=10 rec1=00 rec2=03 rec3=00e
[0x03] rec0=14 rec1=00 rec2=04 rec3=046
[0x04] rec0=1b rec1=00 rec2=05 rec3=010
[0x05] rec0=00 rec1=00 rec2=cd rec3=008
[0x06] rec0=15 rec1=00 rec2=06 rec3=026
[0x07] rec0=00 rec1=00 rec2=cc rec3=03e
[0x08] rec0=17 rec1=00 rec2=07 rec3=048
[0x09] rec0=00 rec1=00 rec2=cb rec3=004
[0x0a] rec0=18 rec1=00 rec2=08 rec3=018
[0x0b] rec0=00 rec1=00 rec2=ca rec3=00a
[0x0c] rec0=15 rec1=00 rec2=09 rec3=03e
[0x0d] rec0=15 rec1=00 rec2=0a rec3=03c
[0x0e] rec0=19 rec1=00 rec2=0b rec3=030
[0x0f] rec0=00 rec1=00 rec2=c9 rec3=002
[0x10] rec0=19 rec1=00 rec2=0c rec3=03c
[0x11] rec0=19 rec1=00 rec2=0d rec3=000
[0x12] rec0=1a rec1=00 rec2=0e rec3=070
[0x13] rec0=01 rec1=00 rec2=c8 rec3=012
[0x14] rec0=18 rec1=00 rec2=0f rec3=020
[0x15] rec0=00 rec1=00 rec2=c6 rec3=004
[0x16] rec0=19 rec1=00 rec2=10 rec3=004
[0x17] rec0=1c rec1=00 rec2=11 rec3=07e
[0x18] rec0=14 rec1=00 rec2=12 rec3=038
[0x19] rec0=16 rec1=00 rec2=13 rec3=004
[0x1a] rec0=1a rec1=00 rec2=14 rec3=008
[0x1b] rec0=17 rec1=00 rec2=15 rec3=008
[0x1c] rec0=1a rec1=00 rec2=16 rec3=036
[0x1d] rec0=19 rec1=00 rec2=17 rec3=018
[0x1e] rec0=1a rec1=00 rec2=18 rec3=026
[0x1f] rec0=1e rec1=00 rec2=19 rec3=04c
[0x20] rec0=18 rec1=00 rec2=c7 rec3=068
[0x21] rec0=01 rec1=00 rec2=1a rec3=012
[0x22] rec0=18 rec1=00 rec2=1b rec3=082
[0x23] rec0=1d rec1=00 rec2=1c rec3=078
[0x24] rec0=14 rec1=00 rec2=1d rec3=046
[0x25] rec0=16 rec1=00 rec2=1e rec3=022
[0x26] rec0=1a rec1=00 rec2=1f rec3=026
[0x27] rec0=17 rec1=00 rec2=20 rec3=026
[0x28] rec0=1a rec1=00 rec2=21 rec3=06e
[0x29] rec0=1b rec1=00 rec2=22 rec3=004
[0x2a] rec0=1a rec1=00 rec2=23 rec3=010
[0x2b] rec0=1d rec1=00 rec2=24 rec3=022
[0x2c] rec0=00 rec1=00 rec2=c5 rec3=014
[0x2d] rec0=19 rec1=00 rec2=25 rec3=01e
[0x2e] rec0=00 rec1=00 rec2=c4 rec3=004
[0x2f] rec0=19 rec1=00 rec2=26 rec3=01e
[0x30] rec0=1d rec1=00 rec2=27 rec3=00e
[0x31] rec0=12 rec1=00 rec2=28 rec3=07c
[0x32] rec0=14 rec1=00 rec2=29 rec3=054
[0x33] rec0=1a rec1=00 rec2=2a rec3=020
[0x34] rec0=19 rec1=00 rec2=2b rec3=01c
[0x35] rec0=1b rec1=00 rec2=2c rec3=044
[0x36] rec0=18 rec1=00 rec2=2d rec3=036
[0x37] rec0=1b rec1=00 rec2=2e rec3=036
[0x38] rec0=1d rec1=00 rec2=2f rec3=02c
[0x39] rec0=17 rec1=00 rec2=30 rec3=020
[0x3a] rec0=00 rec1=00 rec2=c3 rec3=018
[0x3b] rec0=1a rec1=00 rec2=31 rec3=038
[0x3c] rec0=19 rec1=00 rec2=32 rec3=00e
[0x3d] rec0=1a rec1=00 rec2=33 rec3=04c
[0x3e] rec0=11 rec1=00 rec2=34 rec3=044
[0x3f] rec0=19 rec1=00 rec2=35 rec3=01c
[0x40] rec0=19 rec1=00 rec2=36 rec3=012
[0x41] rec0=19 rec1=00 rec2=37 rec3=01e
[0x42] rec0=19 rec1=00 rec2=38 rec3=048
[0x43] rec0=1c rec1=00 rec2=39 rec3=02a
[0x44] rec0=19 rec1=00 rec2=3a rec3=044
[0x45] rec0=1c rec1=00 rec2=3b rec3=05a
[0x46] rec0=01 rec1=00 rec2=c2 rec3=00c
[0x47] rec0=17 rec1=00 rec2=3c rec3=03e
[0x48] rec0=00 rec1=00 rec2=c1 rec3=004
[0x49] rec0=19 rec1=00 rec2=3d rec3=064
[0x4a] rec0=1d rec1=00 rec2=3e rec3=002
[0x4b] rec0=13 rec1=00 rec2=3f rec3=052
[0x4c] rec0=14 rec1=00 rec2=40 rec3=050
[0x4d] rec0=19 rec1=00 rec2=41 rec3=02c
[0x4e] rec0=17 rec1=00 rec2=42 rec3=060
[0x4f] rec0=1c rec1=00 rec2=43 rec3=004
[0x50] rec0=18 rec1=00 rec2=44 rec3=01c
[0x51] rec0=1a rec1=00 rec2=45 rec3=086
[0x52] rec0=1d rec1=00 rec2=46 rec3=024
[0x53] rec0=19 rec1=00 rec2=47 rec3=03e
[0x54] rec0=00 rec1=00 rec2=c0 rec3=014
[0x55] rec0=17 rec1=00 rec2=48 rec3=036
[0x56] rec0=00 rec1=00 rec2=bf rec3=004
[0x57] rec0=19 rec1=00 rec2=49 rec3=038
[0x58] rec0=1d rec1=00 rec2=4a rec3=02a
[0x59] rec0=12 rec1=00 rec2=4b rec3=094
[0x5a] rec0=14 rec1=00 rec2=4c rec3=04e
[0x5b] rec0=17 rec1=00 rec2=4d rec3=01a
[0x5c] rec0=18 rec1=00 rec2=4e rec3=008
[0x5d] rec0=17 rec1=00 rec2=4f rec3=07a
[0x5e] rec0=1c rec1=00 rec2=50 rec3=028
[0x5f] rec0=17 rec1=00 rec2=51 rec3=030
[0x60] rec0=1b rec1=00 rec2=52 rec3=036
[0x61] rec0=1b rec1=00 rec2=53 rec3=016
[0x62] rec0=19 rec1=00 rec2=54 rec3=042
[0x63] rec0=00 rec1=00 rec2=be rec3=018
tail 0x2170069ee819781bbf0c9 0x42a00088462063203
Free Block Chain:
0xce: 0000 00 00 0b 80 2a 83 21 a0 05 60 94 36 00 ae 19 85 ┆ * ! ` 6 ┆