DataMuseum.dk

top - download

    Length: 4353 (0x1101)
    Types: TextFile
    Names: »B«

└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
    └─ ⟦77aa8350c⟧ »DATA« 
        └─⟦f794ecd1d⟧ 
            └─⟦24d1ddd49⟧ 
                └─⟦this⟧ 

TextFile

--    The use of this system is subject to the software license terms and
--    conditions agreed upon between Rational and the Customer.
--
--                Copyright 1988 by Rational.
--
--                          RESTRICTED RIGHTS LEGEND
--
--    Use, duplication, or disclosure by the Government is subject to
--    restrictions as set forth in subdivision (b)(3)(ii) of the Rights in
--    Technical Data and Computer Software clause at 52.227-7013.
--
--
--                Rational
--                3320 Scott Boulevard
--                Santa Clara, California 95054-3197
--
--   PROPRIETARY AND CONFIDENTIAL INFORMATION OF RATIONAL;
--   USE OR COPYING WITHOUT EXPRESS WRITTEN AUTHORIZATION
--   IS STRICTLY PROHIBITED.  THIS MATERIAL IS PROTECTED AS
--   AN UNPUBLISHED WORK UNDER THE U.S. COPYRIGHT ACT OF
--   1976.  CREATED 1988.  ALL RIGHTS RESERVED.
--
--

with Debug_Definitions;
with Debug_Io;
with Runtime_Error;

package body Heap_Management is

    pragma Suppress (Storage_Check);

    use System_Definitions.Operators;
    use Runtime_Error.Values;

    Heap_Size : Natural;
    pragma Import_Object (Heap_Size, "__HEAP_SIZE_VAR");

    Heap_Ptr : Address;
    pragma Import_Object (Heap_Ptr, "__HEAP_PTR");

    Next_Available : Address;
    pragma Import_Object (Next_Available, "__HEAP_NEXT_AVAILABLE");

    First_Unavailable : Address; -- Heap_Ptr + Heap_Size;
    pragma Import_Object (First_Unavailable, "__HEAP_FIRST_UNAVAILABLE");

    -- Debug_Mode : Boolean := Debug_Definitions.Debug_Storage_Management;

    package Heap_Support is

        function Atomic_Add (Sum_Ref : Address;  
                             Addend  : Integer;
                             Maximum : Address) return Address;
        --
        -- if Sum_Ref.all + Addend <= Maximum then
        --    return Sum_Ref.all and
        --         Sum_Ref.all := Sum_Ref.all + Addend;
        --

        function Heap_Align (A : Address) return Address;

    private

        pragma Interface (Asm, Atomic_Add);
        pragma Import_Function (Atomic_Add, "__ATOMIC_ADD_BOUNDED",
                                Mechanism => (Value, Value, Value));

        pragma Interface (Asm, Heap_Align);
        pragma Import_Function
           (Heap_Align, "__HEAP_ALIGN_VALUE", Mechanism => (Value));


    end Heap_Support;


    function Allocate (Size : Integer) return Address is
        pragma Routine_Number (Runtime_Ids.Internal);
        Result : Address;
    begin
        -- if Debug_Mode then
        --     Debug_Io.New_Line;
        --     Debug_Io.Put_Line ("Entered Heap_Management.Allocate");
        --     Debug_Io.Put_Line ("    Size =" & Integer'Image (Size));
        --     Debug_Io.Put_Line ("    First_Available =" &
        --                        Integer'Image (To_Integer (Next_Available)));
        --     Debug_Io.Put_Line ("    First_Unavailable =" &
        --                        Integer'Image (To_Integer (First_Unavailable)));
        -- end if;

        Result := Heap_Support.Atomic_Add
                     (Next_Available'Address, Size, First_Unavailable);

        if To_Integer (Result) = 0 then
            Runtime_Error.Issue (Heap_Exhausted_For_Program);

            -- if Debug_Mode then
            --     Debug_Io.Put_Line
            --        ("Heap_Management.Allocate unable to allocate a block of size" &
            --         Integer'Image (Size) & "; returning null");
            --     Debug_Io.Put_Line ("    available storage =" &
            --                        Integer'Image (To_Integer
            --                                          (First_Unavailable) -
            --                                       To_Integer (Next_Available)));
            -- end if;
        end if;

        -- if Debug_Mode then
        --     Debug_Io.Put_Line ("    Heap_Management.Allocate returning" &
        --                        Integer'Image (To_Integer (Result)));
        -- end if;

        return Result;  
    end Allocate;

begin
    Next_Available    := Heap_Support.Heap_Align (Heap_Ptr);
    First_Unavailable := Plus_Ai (Next_Available, Heap_Size);
end Heap_Management;
pragma Export_Elaboration_Procedure ("__HEAP_MGMT_BODY_ELAB");
pragma Runtime_Unit (Unit_Number         => Runtime_Ids.Runtime_Compunit,
                     Elab_Routine_Number => Runtime_Ids.Internal);