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

⟦f8b295673⟧ Ada Source

    Length: 9216 (0x2400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body List, seg_048904

Derivation

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

with Text_Io;

package body List is

    type Cellule is
        record
            Value : Element;
            Previous, Next : Access_Cell;
        end record;

    Current_Cellule : Access_Cell;

    Free_Cellules : Access_Cell := null;
    Aux_Cellule : Access_Cell;

    function New_Cellule return Access_Cell is
        Result : Access_Cell;
    begin
        if Free_Cellules = null then
            Result := new Cellule;
        else
            Result := Free_Cellules;
            Free_Cellules := Free_Cellules.Next;
        end if;
        Result.Next := null;
        Result.Previous := null;
        return Result;
    end New_Cellule;

    procedure Old_Cellule (Old : Access_Cell) is
    begin
        Old.Next := Free_Cellules;
        Free_Cellules := Old;
    end Old_Cellule;

    procedure Insert (The_List : in out Object; X : in Element) is
    begin
        Current_Cellule := New_Cellule;
        Current_Cellule.Value := X;
        Current_Cellule.Previous := The_List.Last;
        Current_Cellule.Next := null;
        The_List.Last := Current_Cellule;
        if The_List.First = null then
            The_List.First := Current_Cellule;
        else
            Current_Cellule.Previous.Next := Current_Cellule;
        end if;
    end Insert;

    procedure Set_Current_Element (The_List : Object; X : in Element) is
    begin
        Current_Cellule.Value := X;
    end Set_Current_Element;

    function Get_Current_Element (The_List : Object) return Element is
    begin
        if not At_End (The_List) then
            return Current_Cellule.Value;
        end if;
    end Get_Current_Element;

    procedure Remove_Current_Element (The_List : in out Object) is
    begin
        if Current_Cellule = The_List.First then
            The_List.First := The_List.First.Next;
            if The_List.First = null then
                The_List.Last := null;
            end if;
            Old_Cellule (Current_Cellule);
        else
            Current_Cellule.Previous.Next := Current_Cellule.Next;
            if Current_Cellule.Next /= null then
                Current_Cellule.Next.Previous := Current_Cellule.Previous;
            else
                The_List.Last := Current_Cellule.Previous;
            end if;
            Old_Cellule (Current_Cellule);
        end if;
        Current_Cellule := The_List.First;
    end Remove_Current_Element;

    procedure Go_Previous (The_List : Object) is
    begin
        if Current_Cellule /= The_List.First then
            Current_Cellule := Current_Cellule.Previous;
        end if;
    end Go_Previous;

    procedure Go_Next (The_List : Object) is
    begin
        if not At_End (The_List) then
            Current_Cellule := Current_Cellule.Next;
        end if;
    end Go_Next;

    procedure Go_First (The_List : Object) is
    begin
        Current_Cellule := The_List.First;
    end Go_First;

    function At_End (The_List : Object) return Boolean is
    begin
        return Current_Cellule = null;
    end At_End;


begin
    for I in 1 .. Nb_Preallocation_Cellule loop
        Aux_Cellule := New_Cellule;
        Aux_Cellule.Next := Free_Cellules;
        Free_Cellules := Aux_Cellule;
    end loop;
end List;

    nblk1=8
    nid=8
    hdr6=a
        [0x00] rec0=28 rec1=00 rec2=01 rec3=02a
        [0x01] rec0=1d rec1=00 rec2=05 rec3=00c
        [0x02] rec0=01 rec1=00 rec2=07 rec3=00e
        [0x03] rec0=1e rec1=00 rec2=06 rec3=006
        [0x04] rec0=0f rec1=00 rec2=02 rec3=000
        [0x05] rec0=0f rec1=00 rec2=02 rec3=000
        [0x06] rec0=3e rec1=e4 rec2=00 rec3=028
        [0x07] rec0=28 rec1=61 rec2=18 rec3=703
    tail 0x21545d83a865a3ee5f240 0x42a00088462060003
Free Block Chain:
  0x8: 0000  00 03 00 04 80 01 75 01 70 3b 04 00 03 20 20 20  ┆      u p;      ┆
  0x3: 0000  00 04 00 17 80 14 74 5f 43 65 6c 6c 75 6c 65 20  ┆      t_Cellule ┆
  0x4: 0000  00 00 00 04 80 01 20 01 20 20 43 75 72 72 65 6e  ┆          Curren┆