DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

This is an automatic "excavation" of a thematic subset of artifacts from Datamuseum.dk's BitArchive. See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - download

⟦d59bcec1b⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Bd_Jeu, seg_05c2ef

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

package body Bd_Jeu is
    type A_Item;
    type P_Item is access A_Item;
    type A_Item is
        record
            Prev, Next : P_Item;
            Item : Solide;
            No : Integer;
        end record;

    Nb_Solides : Integer := 0;
    Index, First_F, First_B, Last_B : P_Item := null;  
    function Get return P_Item is
        El : P_Item;

    begin
        if First_F = null then
            El := new A_Item;
        else
            El := First_F;
            First_F := El.Next;
        end if;
        El.Prev := Last_B;
        El.Next := null;
        if Last_B /= null then
            Last_B.Next := El;
        end if;
        Last_B := El;
        if First_B = null then
            First_B := El;
        end if;
        return El;
    end Get;
    procedure Put (El : in out P_Item) is
    begin
        if El.Next /= null then
            if El.Prev /= null then
                El.Prev.Next := El.Next;
                El.Next.Prev := El.Prev;
            else
                First_B := El.Next;
                El.Next.Prev := null;
            end if;
        else
            if El.Prev /= null then
                Last_B := El.Prev;
                El.Prev.Next := null;
            else
                First_B := null;
                Last_B := null;
            end if;
        end if;
        El.Next := First_F;
        First_F := El;
    end Put;

    procedure Inserer (Le_Solide : in Solide; No : in Integer) is
        E : P_Item;
    begin
        E := Get;
        E.Item := Le_Solide;
        E.No := No;  
        Nb_Solides := Nb_Solides + 1;
    end Inserer;

    function Rechercher (No : in Integer) return P_Item is
        E : P_Item := First_B;
    begin
        while E /= null loop
            if E.No = No then
                return E;
            else
                E := E.Next;
            end if;
        end loop;
        return null;
    end Rechercher;

    function Rechercher (Le_Solide : in Solide) return P_Item is
        E : P_Item := First_B;
    begin
        while E /= null loop
            if E.Item = Le_Solide then
                return E;
            else
                E := E.Next;
            end if;
        end loop;
        return null;
    end Rechercher;

    procedure Retirer (Le_Solide : in Solide) is
        E : P_Item := Rechercher (Le_Solide);
    begin
        if (Index /= null) and then (Index = E) then
            Index := Index.Next;
        end if;
        if E /= null then
            Put (El => E);
            Nb_Solides := Nb_Solides - 1;
        end if;
    end Retirer;

    procedure Init is
    begin  
        Index := First_B;
    end Init;

    function Prendre return Solide is
    begin  
        if Index /= null then
            return Index.Item;
        else
            return No_Solide;
        end if;
    end Prendre;

    function Prendre (No : in Integer) return Solide is
        E : P_Item := Rechercher (No);
    begin
        if E /= null then
            return E.Item;
        else
            return No_Solide;
        end if;
    end Prendre;

    procedure Suivant is
    begin
        if Index /= null then
            Index := Index.Next;
        end if;
    end Suivant;
end Bd_Jeu;

    nblk1=5
    nid=5
    hdr6=8
        [0x00] rec0=28 rec1=00 rec2=01 rec3=004
        [0x01] rec0=24 rec1=00 rec2=03 rec3=022
        [0x02] rec0=28 rec1=00 rec2=04 rec3=00c
        [0x03] rec0=14 rec1=00 rec2=02 rec3=000
        [0x04] rec0=c0 rec1=00 rec2=00 rec3=100
    tail 0x2176b9b0e895c81dc540a 0x42a00088462060003
Free Block Chain:
  0x5: 0000  00 00 00 cf 80 08 4c 75 29 20 6c 6f 6f 70 08 00  ┆      Lu) loop  ┆