DataMuseum.dk

top - metrics - download

    Length: 2785 (0xae1)
    Types: TextFile
    Names: »B«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

package body Ersatz_Array_Generic is
    Leaf_Block_Size : constant Natural := 1000;
    Indirect_Block_Size : constant Natural := 100;
    Block_Size : constant Natural := 100;

    type Leaf is array (0 .. Leaf_Block_Size - 1) of Element_Ptr;
    type Leaf_Ptr is access Leaf;
    pragma Segmented_Heap (Leaf_Ptr);
    pragma Short_Pointer (Leaf_Ptr);

    type Indirect_Block is array (0 .. Indirect_Block_Size - 1) of Leaf_Ptr;
    type Indirect_Ptr is access Indirect_Block;
    pragma Segmented_Heap (Indirect_Ptr);

    type Block is array (0 .. Block_Size - 1) of Indirect_Ptr;
    Data : Block := (others => null);

    function Fetch (N : Index) return Element_Ptr is
        First_Level : Natural;
        Second_Level : Natural;
        Third_Level : Natural;
        Dex : Natural := Natural (N) - 1;
        I_Ptr : Indirect_Ptr;
        L_Ptr : Leaf_Ptr;
    begin
        Third_Level := Dex mod Leaf_Block_Size;
        Dex := Dex / Leaf_Block_Size;
        Second_Level := Dex mod Indirect_Block_Size;
        First_Level := Dex / Indirect_Block_Size;
        I_Ptr := Data (First_Level);

        if I_Ptr = null then
            Data (First_Level) := new Indirect_Block;
            pragma Heap (Heap);
            I_Ptr := Data (First_Level);
        end if;

        L_Ptr := I_Ptr (Second_Level);

        if L_Ptr = null then
            I_Ptr (Second_Level) := new Leaf;
            pragma Heap (Heap);
            L_Ptr := I_Ptr (Second_Level);
        end if;

        if L_Ptr (Third_Level) = null then
            L_Ptr (Third_Level) := new Element;
            pragma Heap (Heap);
        end if;

        return L_Ptr (Third_Level);
    end Fetch;

    procedure Exchange (A, B : Index) is
        First_Level : Natural;
        Second_Level : Natural;
        A_Third_Level : Natural;
        B_Third_Level : Natural;
        Dex : Natural;
        I_Ptr : Indirect_Ptr;
        A_L_Ptr : Leaf_Ptr;
        B_L_Ptr : Leaf_Ptr;
        Temp : Element_Ptr;
    begin
        Dex := Natural (A) - 1;
        A_Third_Level := Dex mod Leaf_Block_Size;
        Dex := Dex / Leaf_Block_Size;
        Second_Level := Dex mod Indirect_Block_Size;
        First_Level := Dex / Indirect_Block_Size;
        I_Ptr := Data (First_Level);
        A_L_Ptr := I_Ptr (Second_Level);

        Dex := Natural (B) - 1;
        B_Third_Level := Dex mod Leaf_Block_Size;
        Dex := Dex / Leaf_Block_Size;
        Second_Level := Dex mod Indirect_Block_Size;
        First_Level := Dex / Indirect_Block_Size;
        I_Ptr := Data (First_Level);
        B_L_Ptr := I_Ptr (Second_Level);

        Temp := B_L_Ptr (B_Third_Level);
        B_L_Ptr (B_Third_Level) := A_L_Ptr (A_Third_Level);
        A_L_Ptr (A_Third_Level) := Temp;
    end Exchange;
end Ersatz_Array_Generic;