⟦20e1c7086⟧

E3 Source Code



with Unchecked_Deallocation;

with Xlbt_Arithmetic;  
use Xlbt_Arithmetic;

package Xlbt_Univ_Ptr is
------------------------------------------------------------------------------
-- X Library Machine Types
--
-- Xlbt_Univ_Ptr - Machine/Compiler dependent universal-pointer 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_Pointer_Signature - Unique numeric ID's
------------------------------------------------------------------------------

    type X_Pointer_Signature is private;

    None_X_Pointer_Signature : constant X_Pointer_Signature;

------------------------------------------------------------------------------
-- X_Universal_Pointer - a runtime typed data pointer (access type)
------------------------------------------------------------------------------

    type X_Universal_Pointer is private;

    None_X_Universal_Pointer : constant X_Universal_Pointer;

    type X_Universal_Pointer_Array is  
       array (S_Positive range <>) of X_Universal_Pointer;  
    type X_Universal_Pointer_List  is access X_Universal_Pointer_Array;

--/ if Enable_Deallocation then
    pragma Enable_Deallocation (X_Universal_Pointer_List);
--/ end if;

    None_X_Universal_Pointer_List : constant X_Universal_Pointer_List := null;

    procedure Free_X_Universal_Pointer_List
                 (List : in out X_Universal_Pointer_List);


--\x0c
    function X_Universal_Pointer_Signature (Ptr : X_Universal_Pointer)  
                                           return X_Pointer_Signature;
------------------------------------------------------------------------------
--  Ptr - Specifies the X_Universal_Pointer to use
--
-- Called to obtain the X_Poiner_Signature value for the specified universal
-- pointer value.
--
-- Raises X_Invalid_Universal_Pointer if
--  a) Ptr = None_X_Universal_Pointer, or,
--  b) Ptr is a freed universal pointer value (this may or may not be
--     detectable for all implementations and some other implementation
--     specific exception may be raised instead).
------------------------------------------------------------------------------

    function X_Equal_Signature (Ptr1 : X_Universal_Pointer;  
                                Ptr2 : X_Universal_Pointer) return Boolean;  
    function X_Equal_Signature (Ptr : X_Universal_Pointer;  
                                Sig : X_Pointer_Signature)  return Boolean;  
    function X_Equal_Signature (Sig1 : X_Pointer_Signature;  
                                Sig2 : X_Pointer_Signature) return Boolean;
--------------------------------------------------------------------------
-- Returns TRUE if a) either value is None or b) the signature valu of the
-- first parameter is the same as the signature value for the second parameter.
------------------------------------------------------------------------------

    generic  
        type Data_Type   is limited private;  
        type Access_Type is access Data_Type;  
        with procedure Free_Access_Type (Acc : in out Access_Type);  
    package X_Universal_Pointer_Conversion is

        function To_X_Universal_Pointer  
                    (Ptr : Access_Type) return X_Universal_Pointer;
------------------------------------------------------------------------------
--  Ptr - Specifies the Access_Type value to "convert"
--
-- Use this to exchange an Access_Type value for a universal pointer value.
-- The universal pointer may be used any number of times to retrieve the
-- same Access_Type value.  Please note that if the Access_Type value is
-- freed then the universal pointer value becomes a "dangling pointer" and
-- it should be freed as well.
--
-- Returns None_X_Universal_Pointer if Ptr = null.
--
-- May raise implementation-specific exceptions in obscure cases, e.g. type is
-- not fully elaborated yet (on systems that are capable of detecting it), or,
-- Storage_Error (on systems that implement this package by allocating storage).
--
-- Note: On some systems this allocates heap storage.  Be sure to use the
-- Free_X_Universal_Pointer routine on all pointer values when they are no
-- longer required.  This will prevent storage loss.
------------------------------------------------------------------------------

        function From_X_Universal_Pointer  
                    (Ptr : X_Universal_Pointer) return Access_Type;
------------------------------------------------------------------------------
--  Ptr - Specifies the universal pointer to "convert"
--
-- Use this to exchange a universal pointer for the Access_Type value that was
-- used initially to create the universal pointer value.
--
-- Returns null if Ptr = None_X_Universal_Pointer.
--
-- Raises X_Invalid_Universal_Pointer if
--  a) Ptr = None_X_Universal_Pointer, or,
--  b) the universal pointer value does not correspond to a value of this
--     Access_Type (the signature is different), or,
--  c) Ptr is a freed universal pointer value (this may or may not be
--     detectable for all implementations and some other implementation
--     specific exception may be raised instead).
--
-- Note: On some systems universal pointers are implemented by allocating heap
-- storage.  Be sure to use the Free_X_Universal_Pointer routine on all pointer
-- values when they are no longer required.  This will prevent storage loss.
------------------------------------------------------------------------------

        procedure Free_X_Universal_Pointer (Ptr : in out X_Universal_Pointer);  
        function  Free_X_Universal_Pointer  
                    (Ptr : X_Universal_Pointer) return Access_Type;
----------------------------------------------------------------------------
--  Ptr - Specifies the universal pointer value to be freed
--
-- Called to free a universal pointer value when it is no longer needed.
-- The functional version also returns the access value associated with the
-- universal pointer.
--
-- These are called to deallocate the universal pointer value (especially
-- important if it was allocated upon the heap).  These routines do *not*
-- deallocate the Access_Type value and they do *not* reference the value
-- of the Access_Type in any way.  An Access_Type value and the associated
-- universal pointer value can be freed in any order.
--
-- Raises X_Invalid_Universal_Pointer if
--  a) Ptr = None_X_Universal_Pointer, or,
--  b) the universal pointer value does not correspond to a value of this
--     Access_Type (the signature is different), or,
--  c) Ptr is a freed universal pointer value (this may or may not be
--     detectable for all implementations and some other implementation
--     specific exception may be raised instead).
------------------------------------------------------------------------------

        procedure Free_Both_X_Universal_Pointer  
                     (Ptr : in out X_Universal_Pointer);
-----------------------------------------------------------------------------
--  Ptr - Specifies the universal pointer value to be freed
--
-- Called to free a universal pointer value and the associated access value
-- when they are no longer needed.
--
-- This routine deallocates the Access_Type value as well.  It should not be
-- called if the access value is to be, or was already, deallocated separately.
--
-- Raises X_Invalid_Universal_Pointer if
--  a) Ptr = None_X_Universal_Pointer, or,
--  b) the universal pointer value does not correspond to a value of this
--     Access_Type (the signature is different), or,
--  c) Ptr is a freed universal pointer value (this may or may not be
--     detectable for all implementations and some other implementation
--     specific exception may be raised instead).
------------------------------------------------------------------------------

    end X_Universal_Pointer_Conversion;

--\x0c
private

    type X_Pointer_Signature is  
        record  
            First  : S_Long;  
            Second : S_Long;  
        end record;

    None_X_Pointer_Signature : constant X_Pointer_Signature := (S_Long'First,  
                                                                S_Long'First);

    type X_Universal_Pointer_Rec;  
    type X_Universal_Pointer is access X_Universal_Pointer_Rec;

--/ if Enable_Deallocation then
    pragma Enable_Deallocation (X_Universal_Pointer);
--/ end if;

    None_X_Universal_Pointer : constant X_Universal_Pointer := null;

end Xlbt_Univ_Ptr;
DataMuseum.dk

Rational R1000/400

⟦20e1c7086⟧ Ada Source

Derivation

E3 Source Code

E3 Meta Data
